Ten skrypt pozwala na szybkie tworzenie bloków z dowolnych elementów na rysunku.
Polecenie do uruchomienia skryptu LISP: Blokuj
Kod źródłowy z opisem
;;; Tworzenie bloków ze wskazanych elementów
;;; zwcad.pl
;;; Polecenie do uruchomienia skryptu LISP: Blokuj
;;; Opis: https://www.zwcad.pl/materialy-edukacyjne/kurs-lisp/przyklady-lisp/123-bloki-tworzenie-blokow-ze-wskazanych-elementow.html
(vl-load-com)
; wymiarowanie kątowe z UCS
(setq *ZWCAD* (vlax-get-acad-object))
(setq *Rysunek* (vla-get-activedocument *ZWCAD* ))
(setq *Model* (vla-get-Modelspace *Rysunek* ))
(defun C:Blokuj ( / Wybor WyborLst Nazwa P0 Def ObjSfA ref elem )
;----------------------------------------------------------
; funkcja Tworzy blok z zaznaczonych elementów
; Argumenty: brak
; Wynik: brak
;----------------------------------------------------------
(setq Wybor (ssget )) ; pozwala Użytkownikowi na wskazanie dowolnych obiektów
(setq WyborLst (sel2list Wybor)) ; zamieniamy na listę, by móc łatwiej nią manipulować
(setq *Bloki*(vlax-get-property *Rysunek* 'Blocks ) )
(setq Nazwa (XGetString "Podaj nazwę bloku lub <*>" "*U") ) ; prosimy Użytkownika o podanie nazwy
(setq P0 (XGetpoint "Wskaż punkt <(0 0 0)>" nil (list 0 0 0 ))) ; prosimy Użytkownika o wskazanie punku
(setq Def (vlax-invoke-method *Bloki* 'Add (vlax-3d-point P0 ) Nazwa)); tworzymy nowy blok
(setq ObjSfA (vlax-make-safearray vlax-vbObject(cons 0 (1- (length WyborLst))))) ; Tworzenie safearray,
; taki typ jest potrzebny w funkcji kopiującej elementy do innego bloku
(vlax-safearray-fill ObjSfA WyborLst) ; Wypełnienie safearray obiektami
(vla-CopyObjects *Rysunek* ObjSfA Def) ; Kopiowanie do bloku
(setq ref (vlax-invoke-method *Model* 'InsertBlock (vlax-3d-point P0) (vla-get-name Def) 1 1 1 0))
; wstawienie bloku
(foreach elem WyborLst (vlax-invoke-method elem 'Delete ) ) ; usunięcie elementów wzorcowych
(print "" )
)
(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 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 punktu 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 punktu - jeśli Użytkownik je poda
; współrzędne punktu 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ń komunikat błędu
(setq Wynik nil )
)
(progn ; Użytkownik wskazał punkt lub [ENTER]/[SPACE]
(if (null Px)
(setq Wynik domyslny )
(setq Wynik Px)
)
)
)
Wynik
)
(defun XGetString (komunikat domyslny / Wynik )
;----------------------------------------------------------
;funkcja prosi użytkownika o podanie tekstu
;Argumenty: komunikat, zachętę, który sie wyświetli w linii poleceń w chwili uruchomienia funkcji
;Wynik: tekst który Użytkownik wpisze z klawiatury
; nil - jeśli Użytkownik na klawiaturze wciśnie [ESC]
;----------------------------------------------------------
(setq Tresc(vl-catch-all-apply 'getstring (list komunikat ))) ;wykonanie funkcji getstring
; proszącej o podanie treści tekstu zwraca wpisaną treść lub obiekt błędu
(if (vl-catch-all-error-p Tresc) ; sprawdzenie czy zwrócony został obiekt błędu
(progn ; wystąpił błąd
(prompt (vl-catch-all-error-message Tresc)) ;wyświetla w pasku poleceń komunikat błędu
(setq Wynik nil )
)
(progn ; Użytkownik wpisał tekst poprawnie
(if (= "" Tresc)
(setq Wynik domyslny )
(setq Wynik Tresc)
)
)
)
Wynik
)
Wykonanie w ZWCAD 2023
Wykonanie w ZWCAD 2015
