Ten skrypt pozwala na przenoszenie obiektów po osi X, z zablokowaną współrzędną Y.
Przesuwanie z zablokowaniem wspołrzędnej
Polecenie do uruchomienia skryptu LISP: MoveByX
Kod źródłowy z opisem
;;; Przesuwanie z zablokowaniem wspolrzędnej
;;; zwcad.pl
;;; Polecenie do uruchomienia skryptu LISP: MoveByX
;;; Opis: https://www.zwcad.pl/materialy-edukacyjne/kurs-lisp/przyklady-lisp/185-przesuwanie-z-zablokowaniem-wspolrzednej.html
(vl-load-com)
(setq *ZWCAD* (vlax-get-acad-object))
(setq *Rysunek* (vla-get-activedocument *ZWCAD* ))
(setq *Model* (vla-get-Modelspace *Rysunek* ))
(defun XGetpoint (tresc P0 domyslny / Px Wynik )
;----------------------------------------------------------
;Funkcja prosi Użytkownika o podanie punktu, jeśli Użytkownik wciśnie na klawiaturze spację lub
; enter, funkcja zwróci współrzędne punku domyślnego przekazane jako argument funkcji
;Argumenty: komunikat, zachętę, który sie wyświetli w linii poleceń w chwili uruchomienia funkcji
;Wynik: współrzędne punku - jeśli Użytkownik je poda
; współrzędne punku domyślnego - jeśli Użytkownik na klawiaturze wciśnie [ENTER] [SPACJA]
; nil - jeśli Użytkownik na klawiaturze wciśnie [ESC]
;----------------------------------------------------------
(if (not(null P0))
(setq Px(vl-catch-all-apply 'getpoint (list P0 tresc ))) ;wykonanie funkcji getpoint proszącej
; o wskazanie punktu) zwraca współrzędne punktu lub obiekt błędu
(setq Px(vl-catch-all-apply 'getpoint (list tresc )))
)
(if (vl-catch-all-error-p Px) ; sprawdzenie czy zwrócony został obiekt błędu
(progn ; wystąpił błąd
(prompt (vl-catch-all-error-message Px)) ;wyświetla w pasku poleceń komumikat błędu
(setq Wynik nil )
)
(progn ; Użytkownik wskazał punkt lub [ENTER]/[SPACE]
(if (null Px)
(setq Wynik domyslny )
(setq Wynik Px)
)
)
)
Wynik
)
(defun XSSGet (tresc / selElems elementy )
;----------------------------------------------------------
; funkcja sprawdza, czy jakieś elementy zostały zaznaczone, jeśli nie, prosi użytkownika
; o wskazanie obiektów
; Argumenty: tresc - komunikat wyświetlany w pasku poleceń zachęta do wskazanie obiektów
; Wynik: lista wybranych obiektów jeśli coś zostało wybranie
; nil jeśli nic nie zostało wybrane.
;----------------------------------------------------------
(setq selElems(ssgetfirst ))
(if (car selElems)
(setq elementy (sel2list (car selElems)))
(progn
(princ tresc )
(setq elementy(vl-catch-all-apply 'ssget (list )))
(if (not(vl-catch-all-error-p elementy))
(progn
(setq elementy (sel2list elementy ))
)
)
)
)
elementy
)
(defun sel2list (selset / Wynik ileelementow i)
;----------------------------------------------------------
; funkcja zamienia zbiór wskazań na listę obiektów
; Argumenty: zbiór wskazań (selectionset)
; Wynik: lista
;----------------------------------------------------------
(setq ileelementow(sslength selset) )
(setq i 0 )
(repeat ileelementow
(setq Wynik (append Wynik (list (vlax-ename->vla-object(ssname selset i) ) )))
(setq i (1+ i ))
)
Wynik
)
(defun C:MoveByX ( / Objekty P1 P2 P1V P2V % )
;----------------------------------------------------------
; funkcja działa podobnie, jak standardowa funkcja ZWCADa move, czyli przesuwa zaznaczone
; obiekty, ale blokuje pozycję Y
; Argumenty: brak
; Wynik: brak
;----------------------------------------------------------
(setq Objekty (XSSGet "\nWskaż obiekty do przesunięcia"))
(if (not(null Objekty)) (progn
(setq P1 (XGetpoint "\nWskaż punkt bazowy" nil nil ))
(if P1 (progn
(setq P2 (XGetpoint "\nWskaż punkt przesunięcia" P1 nil ))
(if P2 (progn
(setq P1V (vlax-3d-point P1 ) )
(setq P2V (vlax-3d-point (list (car P2)(cadr P1)(caddr P2) ) ))
(foreach % Objekty
(vlax-invoke-method % 'Move P1V P2V)
)
))
))
))
(princ )
)
Wykonanie w ZWCAD 2023
Wykonanie w ZWCAD 2015
Wykonanie w ZWCAD Classic