Prostokąt obejmujacy

Użytkownik ZWCADa zasugerował nam, że przydatnym narzędziem w ZWCAD mogłaby być funkcja, która po zaznaczeniu elementów w rysunku, utworzy polilinię - prostokąt, obejmujący wszystkie te elementy.
ZWCAD posiada LISPową funkcję, która pozwala na odczytanie wierzchołków przekątnej takiego prostokąta dla każdego elementu.
Po użyciu tej funkcji na każdym zaznaczonym elemencie pozostaje nam je połączyć.

Cała procedura - skrypt LISP - jest następujący:

Pobierz teraz LISP: Prostokat obejmujacy

Polecenie do uruchomienia skryptu LISP: Obrys

Kod źródłowy z opisem:

;;; Prostokąt obejmujący
;;; zwcad.pl
;;; Polecenie do uruchomienia skryptu LISP: Obrys
;;; Opis: https://www.zwcad.pl/materialy-edukacyjne/kurs-lisp/przyklady-lisp/341-prostokat-obejmujacy.html


(vl-load-com)
(setq *ZWCAD* (vlax-get-acad-object))
(setq *Rysunek* (vla-get-activedocument *ZWCAD* ))

(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 selset elementy)
  (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 BBoxDodaj (BBox Px / LD PG MinX MaxX MinY MaxY)
;----------------------------------------------------------
; funkcja powiększa obszar obejmujący o dodatkowy punkt, jeśli jest on poza zdefiniowanym obszarem
; Argumenty: BBox - lista współrzędnych dwóch punktów, lewego dolnego i prawego górnego narożnika
; prostokąta obejmującego
; Px - nowy punkt, o kóry powiększony będzie obszar, prostokąta obejmującego (jeśli jest poza obszarem)
; Wynik: lista współrzędnych dwóch punktów, lewego dolnego i prawego górnego narożnika prostokąta obejmującego
;----------------------------------------------------------
	(setq LD (car BBox)) ; odczytanie lewego
; dolnego narożnika
	(setq PG (cadr BBox)) ; odczytanie prawego górnego narożnika
	(setq MinX (if (< (car Px) (car LD) ) (car Px) (car LD) )) ; sprawdzanie czy współrzędna X nowego
	; punktu jest mniejsza niż X lewego dolnego narożnika
	(setq MaxX (if (> (car Px) (car PG) ) (car Px) (car PG) )) ; sprawdzanie czy współrzędna X nowego
	; punktu jest większa niż X prawego górnego narożnika
	(setq MinY (if (< (cadr Px) (cadr LD) ) (cadr Px) (cadr LD) )) ; sprawdzanie czy współrzędna Y nowego
	; punktu jest mniejsza niż Y lewego dolnego narożnika
	(setq MaxY (if (> (cadr Px) (cadr PG) ) (cadr Px) (cadr PG) )) ; sprawdzanie czy współrzędna Y nowego
	; punktu jest większa niż Y prawego górnego narożnika
	(list (list MinX MinY) (list MaxX MaxY)) ; otworznie listy wynikowej wierzchołków najmniejszych i największych
)


; (setq P1 (car Suma) P2 (cadr Suma ) )
(defun RysujRamke (P1 P2 / LPts Vpts ramka )(setq *Model* (vla-get-Modelspace *Rysunek* ))
	(setq LPts (list (car P1)(cadr P1)
		(car P2)(cadr P1) ; określenie wsółrzędnych wszystkich narożników na podstawie jedynie dwóch - przekątnej
		(car P2)(cadr P2)
		(car P1)(cadr P2) 
	) )
	(setq Vpts (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbdouble (cons 0 (1- (length Lpts)))) Lpts ) ))
	; zamiana wierzchołków z listy na variant - kolejna funkcja wymaga variantu jako parametru wejściowego
	(setq ramka(vlax-invoke-method *Model* 'addlightweightpolyline Vpts)) ; utowrznenie obrysu
	(vlax-put-property ramka 'Closed :vlax-true ) ; zamyka polilinię.
)

(defun C:Obrys ( / )
	(setq elementy (XSSGet "Wskaż elementy do obrysowania" ) )
	(if elementy 
	  (progn
	    (vla-GetBoundingBox (car elementy ) 'LD 'PG )  ; funkcja odczytuje wierzchołki prostokąta
	; obejmującego
	; funkcja zawsze zwraca wartość nil co może być mylące
	; do parametrów wywołania funkcji (LD i PG) przypisane są współrzędne
		(if (and LD PG) ; sprawdzenie, czy funkcja wypełniła poprawnie zmeinne LD i PG
			(setq Suma (list (vlax-safearray->list LD) (vlax-safearray->list PG )))
	; początkowy obrys wykonywany zawsze dla pierwszego wskazanego elementu,
		)
		(foreach % elementy ; dla każdego wybranego elementu pobiera prostokąt obejmujacy
			(setq LD nil PG nil )
			(vla-GetBoundingBox % 'LD 'PG)
			(if (and LD PG) (progn
				(setq Suma (BBoxDodaj Suma (vlax-safearray->list LD) )) ; powiększenie sumarycznego prostokąta
	; obejmującego jeśli to konieczne
				(setq Suma (BBoxDodaj Suma (vlax-safearray->list PG ))) ; powiększenie sumarycznego prostokąta
	; obejmującego jeśli to konieczne))
			))
		)
		(RysujRamke (car Suma) (cadr Suma )) ; wyrysowanie ramki obejmującej wszystkie elementy.))
	) )
	(princ )
)

Wykonanie w ZWCAD 2023

Wykonanie w ZWCAD 2015

Wykonanie w ZWCAD Classic