Przecięcia linii

;;; Przecięcia linii
;;; zwcad.pl
;;; Polecenie do uruchomienia skryptu LISP: Przeciecia1, Przeciecia2, Przeciecia3, PrzecieciaObiektow
;;; Opis: https://www.zwcad.pl/materialy-edukacyjne/kurs-lisp/przyklady-lisp/180-przeciecia-linii.html

(vl-load-com)
(setq *ZWCAD* (vlax-get-acad-object))
(setq *Rysunek* (vla-get-activedocument *ZWCAD* ))
(setq *Model* (vla-get-Modelspace *Rysunek* ))
(defun C:Przeciecia1 ( / 
 *error* ) (defun *error* ( msg / ) 
 (if (not (null msg ) ) (progn (princ "\nC:Przeciecia:*error*: " ) (princ msg ) (princ "\n") ) )
 )
 (command "ZOOM" "70,455" "320,170")
 (setq P1 (getpoint "Wskaż P1" ))
 (setq P2 (getpoint "Wskaż P2" P1) )
 (setq P3 (getpoint "Wskaż P3") )
 (setq P4 (getpoint "Wskaż P4" P3) )
 (setq Px(inters P1 P2 P3 P4 ))
 ; funkcja inters oblicza punkt przeciecia linii zdefiniowanych przez dwie pary punktów. 
 ; jeśli przecięcie linii nie znajduje sie na liniach, a na ich przedłużeniach, konieczne jest użycie dodatkowego parametru, którego wartość powinna być równa nil.
 (setq Interpoint (vlax-invoke-method *Model* 'AddPoint (vlax-3d-point Px))) ; ZWCAD
)
(defun C:Przeciecia2 ( / 
 *error* ) (defun *error* ( msg / ) 
 (if (not (null msg ) ) (progn (princ "\nC:Przeciecia:*error*: " ) (princ msg ) (princ "\n") ) )
 )
 (command "ZOOM" "735,455" "1050,170")
(setq P1 (getpoint "Wskaż P1" ))
(setq P2 (getpoint "Wskaż P2" P1) )
(setq P3 (getpoint "Wskaż P3") )
(setq P4 (getpoint "Wskaż P4" P3) )
(setq Px(inters P1 P2 P3 P4 ))
; funkcja inters oblicza punkt przeciecia linii zdefiniowanych przez dwie pary punktów. 
; jeśli przecięcie linii nie znajduje sie na liniach, a na ich przedłużeniach, konieczne jest użycie dodatkowego parametru, którego wartość powinna być równa nil.
)
(defun C:Przeciecia3 ( / 
 *error* ) (defun *error* ( msg / ) 
 (if (not (null msg ) ) (progn (princ "\nC:Przeciecia:*error*: " ) (princ msg ) (princ "\n") ) )
 )
 (command "ZOOM" "1400,455" "1700,170")
(setq P1 (getpoint "Wskaż P1" ))
(setq P2 (getpoint "Wskaż P2" P1) )
(setq P3 (getpoint "Wskaż P3") )
(setq P4 (getpoint "Wskaż P4" P3) )
(setq Px(inters P1 P2 P3 P4 nil))
; funkcja inters oblicza punkt przeciecia linii zdefiniowanych przez dwie pary punktów. 
; jeśli przecięcie linii nie znajduje sie na liniach, a na ich przedłużeniach, konieczne jest użycie dodatkowego parametru, którego wartość powinna być równa nil.
(print Px )
(setq Interpoint (vlax-invoke-method *Model* 'AddPoint (vlax-3d-point Px))) ; ZWCAD
)
(defun C:PrzecieciaObiektow( / 
 *error* ) (defun *error* ( msg / ) 
 (if (not (null msg ) ) (progn (princ "\nname:*error*: " ) (princ msg ) (princ "\n") ) )
 ) 
 (command "ZOOM" "2000,455" "2300,170")
 ;Mamy również możliwość obliczania puntów przecięcia istniejących obiektów. Dla przykładu narysujmy dwa okręgi przecinające się na obwodzie.
 ;Funkcja IntersectWith zwrala listę współrzędnych punków przecięcia obiektów
 ; Prosimy Użytkownika o wskazanie Okręgów:
 (setq Cir1(vlax-ename->vla-object(car(entsel "wskaż pierwszy element"))))
 (setq Cir2(vlax-ename->vla-object(car(entsel "wskaż drugi element"))))
 ; pobieramy punkty przecięć
 (setq InterPoints(vlax-invoke-method Cir1 'IntersectWith Cir2 zcExtendNone ))
 ; Dla łatwieszego uwidocznienia działania rysujemy linię, łączącą te punkty
 (setq InterPointsList(vlax-safearray->list(vlax-variant-value InterPoints)))
 (setq LP1 (list (car InterPointsList)(cadr InterPointsList)(caddr InterPointsList)))
 (setq LP2 (list (nth 3 InterPointsList)(nth 4 InterPointsList)(nth 5 InterPointsList)))
 (setq TestLine(vlax-invoke-method *Model* 'AddLine (vlax-3d-point LP1 ) (vlax-3d-point LP2) ))
)