W tym przykładzie chciałbym pokazać jak można usprawnić ZWADową funkcję przerwij w dwóch punktach. 

 Domyślna funkcja ZWCADa prosi o wskazanie obiektu, i punktu przerwania. Jako pierwszy punkt  domyślnie jest przyjmowany punkt kliknięty przy wskazywaniu obiektu, jednak ten punkt nie uwzględnia punktów charakterystycznych, co może spowodować niedokładności w wynikowym obiekcie.

W przykłądzie powstanie funkcja BR, która prosi o wskaznie obiektu i daje możliwość wskazanie wielu punktów, w których podzieline będzie wybrany element.

 

(vl-load-com)

(setq *ZWCAD* (vlax-get-acad-object))
(setq *Rysunek* (vla-get-activedocument *ZWCAD* ))
(setq *Model* (vla-get-Modelspace *Rysunek* ))


(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 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 C:br ( / selelem Px ElementyDoPodzialu)
(setq selelem (XEntSel "Wskaż element do przerwania" ))
(if selelem
(progn
(setq ElementyDoPodzialu (list selelem ))
(setq Px (XGetpoint "Wskaż punt przerwania" nil nil))
(while Px
(setq ElementyDoPodzialu (podzial ElementyDoPodzialu Px))
(setq Px (XGetpoint "Wskaż punt przerwania" nil nil))
)
)
)
(princ)
)

(defun PtToStr (Px / ) ; zamienia listę współrzędnych na tekst gdzie współrzędne oddzielane są przecinkami
(strcat (rtos(car Px) 2 ) "," (rtos(cadr Px) 2 ) "," (rtos(caddr Px) 2 ))
)

(defun podzial ( selelems Px / ostatni zrzutowany minodl minobj % odl nowyostatni OutList )

; 1. zapisuję ostatni element dodany do rysunku.
; jest to potrzebne po to, żeby sprawdzić czy powstał nowy element przy użyciu funkcji break
(setq ostatni (entlast) )
; 2. w wyniku działania funkcji powstaje lista obierktów, która jest coraz większa po każdym wywołaniu funkcji.
; konieczne jest więc określenie który z elementów listy jest najbliżej klikniętego punktu, żeby właśnie jego przerwać, a nie dowolny inny obiekt z listy

; przyjmujemy że pierwszy element listy jest najbliżej punku, ponieważ musimy w kolejnych porównaniach mieć jakąś wartość początkową do porównania.
(setq zrzutowany (vlax-curve-getClosestPointTo (car selelems) Px ))
(setq minodl (distance Px zrzutowany))
(setq minobj (car selelems))

(foreach % selelems ; (setq % (nth 1 selelems))
(setq zrzutowany (vlax-curve-getClosestPointTo % Px ))
(setq odl (distance Px zrzutowany))
(if (< odl minodl) ; jeśli odległość obiektu od klikniętego puktu jest mniejsza od najmniejszej
(progn
(setq minobj % minodl odl) ; to zmieniamy który jest najbliżej i jaka jest najmniejsza odległość
))
)

(command "_BREAK" (vlax-vla-object->ename minobj) (PtToStr Px) "@") ; dzielimy obiekt najbliższy klikniętemu punktowi w tym punkcie

(setq nowyostatni (entlast) )
(if (not(eq ostatni nowyostatni )) ; sprawdzamy czy powstał nowy element
(progn ; jeśli tak, dodajemy go do listy elementów, które będziemy sprawdzać w kolejnym wywołaniu funkcji
(setq OutList (append selelems (list (vlax-ename->vla-object nowyostatni ) )))
))

OutList
)

(princ)

Wykonanie w ZWCAD 2015+LISP Podzial 2015

 

Wykonanie w ZWCAD ClassicLISP Podzial Classic