Głównym tematem tego przykładu jest dodawanie punktów do polilinii.
Być może nie jest to rozwiązanie kompleksowe pozwalające na dodawanie punktów do wszystkich polilinii, problematycze będzie np dodanie punktu do odcinków łukowych. Chciałbym raczej pokazać tutaj użycie kilku funkcji np: eval, command, vlax-curve-getClosestPointTo wybieranie obiektów i ich filtrowanie.

Dodawanie punktow do polilinii

Polecenie do uruchomienia skryptu LISP: PunktDoPolilinii

Kod źródłowy z opisem

;;; Dodawanie punktów do polilinii
;;; zwcad.pl
;;; Polecenie do uruchomienia skryptu LISP: PunktDoPolilinii
;;; Opis: https://www.zwcad.pl/materialy-edukacyjne/kurs-lisp/przyklady-lisp/222-dodawanie-punktow-do-polilinii.html

(vl-load-com)
(defun XEntSel (tex / SelObj Sel)
(setq Sel(vl-catch-all-apply 'entsel (list tex))) ; prosi Użytkownika o wybranie jednego obiektu
; jeśli wystąpi błąd w czasie wybierania, np Użytkownik anuluje polecenie, zdażenie takie zostanie przechwycone i pozwoli na dalsze działanie programu
(if Sel (progn
(if (vl-catch-all-error-p Sel) ; zwraca t, jeśli wystąpiło przerwanie
(progn
(prompt (vl-catch-all-error-message Sel)) ; wyświetla komunikat błędu
(setq SelObj nil )
)
(progn
(setq SelObj (vlax-ename->vla-object(car Sel))) ; zamienia wybrany obiekt typu entity na obiekt
)
)
))
SelObj
)
(defun FilterObj (Obj Filter / OutVal ObjType)
(setq OutVal nil)
(cond
((=(type Obj) 'VLA-OBJECT) (progn
(setq ObjType(vlax-get-property Obj "EntityName"))
(if (member ObjType Filter)
(setq OutVal Obj )
)
))
( T (print ObjType ))
)
OutVal
)
(defun XGetpoint (tresc P0 domyslny / Pt Wynik )
(if (not(null P0))
(setq Pt(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 Pt(vl-catch-all-apply 'getpoint (list tresc )))
)
(if (vl-catch-all-error-p Pt) ; sprawdzenie czy zwrócony został obiekt błędu
(progn ; wystąpił błąd
(prompt (vl-catch-all-error-message Pt)) ;wyświetla w pasku poleceń komumikat błędu
(setq Wynik nil )
)
(progn ; Użytkownik wskazał punkt lub [ENTER]/[SPACE]
(if (null Pt)
(setq Wynik domyslny )
(setq Wynik Pt)
)
)
)
Wynik
)
(defun v2l (var)(vlax-safearray->list(vlax-variant-value var)))
(defun DodajPunkt (Poly pt / NewPt cmdval wspolrzedne_var wspolrzedne_lst i P1 P2 distP1ptP2 distP1P2 )
(setq NewPt(vlax-curve-getClosestPointTo Poly pt)) ; "rzutowanie" punktu na krzywą
(setq cmdval (list 'command "_Pedit" (vlax-vla-object->ename Poly) "_e")) ; tworzy polecenie, które na koniec zostanie wykonane
(if NewPt (progn
(setq wspolrzedne_var (vlax-get-property Poly 'Coordinates ) ) ; pobiera współrzędne kolejnych wierzchołków polilinii
(setq wspolrzedne_lst (v2l wspolrzedne_var))
(setq i 0 )
(while (< i (length wspolrzedne_lst))
(setq P1(list (nth i wspolrzedne_lst) (nth (+ i 1) wspolrzedne_lst) 0))
(setq P2(list (nth (+ i 2) wspolrzedne_lst) (nth (+ i 3) wspolrzedne_lst) 0))
(setq distP1ptP2 (+(distance NewPt P1) (distance NewPt P2)) )
(setq distP1P2 (distance P1 P2))
(if (equal distP1ptP2 distP1P2 0.1) ; sprawdzanie czy punkt leży na poliilnii, jeśli kliknięto punkt na odcinku łukowym, sprawdzanie takie powinno być bardziej rozbudowane
(progn
; przypadek, gdy punkt jest tym odcinku polilinii, wchodzimy do odpowiedniej opcji, dodajemy punkt, zamykamy funkcję
(setq cmdval(append cmdval (list "_I" (strcat(rtos(car NewPt) 2 5) "," (rtos(cadr NewPt) 2 5)) "_X" "")))
(setq i (+ (length wspolrzedne_lst) 2) )
)
(progn ;punkt nie leży na wybranym odcinku polilinii, konieczne przejście do kolejnego punktu.
(setq cmdval(append cmdval (list "_N")))
)
)
(setq i (+ i 2) )
)
))
(eval cmdval) ; wykonaj utworzone polecenie
nil
)
(defun C:PunktDoPolilinii ( / Wybrane Punkt )
(setq Wybrane (XEntSel "Wskaż polilinię."))
(setq Wybrane (FilterObj Wybrane (list "AcDbPolyline" )))
(if Wybrane (progn
(setq Punkt (XGetpoint "wskaż punkt do dodania" nil nil ))
(if Punkt (progn
(DodajPunkt Wybrane Punkt)
))
)
)
)

Wykonanie w ZWCAD 2023

Wykonanie w ZWCAD 2015

* Lisp nie jest kompatybilny z ZWCAD Classic