Dzięki temu narzędziu można w łatwy sposób opisywać wierzchołki obiektów albo dowolne punkty w projekcie.
Polecenie do uruchomienia skryptu LISP: Oznacz
Kod źródłowy z opisem
;;; Opisywanie współrzędnych
;;; zwcad.pl
;;; Polecenie do uruchomienia skryptu LISP: Oznacz
;;; Opis: https://www.zwcad.pl/materialy-edukacyjne/kurs-lisp/przyklady-lisp/187-opisywanie-wspolrzednych-w-rysunku.html
(vl-load-com)
(setq *ZWCAD* (vlax-get-acad-object))
(setq *Rysunek* (vla-get-activedocument *ZWCAD* ))
(setq *Model* (vla-get-Modelspace *Rysunek* ))
(defun d2r (degs /)
;----------------------------------------------------------
;funkcja zamienia wartość kąta zapisaną w stopniach na jej odpowiednik w radianach
;Argumenty: liczba, wartość kąta w stopniach
;Wynik: liczba, wartość kąta w radianach
;----------------------------------------------------------
(/(* pi degs)180.0)
)
(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 BlokOpisowy ( / )
(setq Nazwa "Wspolrzedne")
(setq CzyIstnieje (tblsearch "BLOCK" Nazwa)) ; sprawdzenie czy wcześniej był utworzony blok o takiej nazwie
(setq Bloki (vlax-get-property *Rysunek* 'Blocks )) ; pobranie kolekcji bloków
(if CzyIstnieje
(progn
(setq Blok (vla-item Bloki Nazwa)) ; pobranie bloku z kolekcji
)
(progn
(setq P0 (vlax-3d-point (list 0 0 0)) )
(setq Blok (vlax-invoke-method Bloki 'Add P0 Nazwa ) )
(setq XAttr (vlax-invoke-method Blok 'AddAttribute 1 zcAttributeModeNormal "X" P0 "X" "X" ) )
(setq YAttr (vlax-invoke-method Blok 'AddAttribute 1 zcAttributeModeNormal "Y" P0 "Y" "Y" ) )
(vlax-invoke-method YAttr 'Rotate P0 (d2r 90))
)
)
Blok
)
(defun Atrybuty (Blok / Attr AttrList % OutList )
;----------------------------------------------------------
; funkcja pobiera listę atrybutów z bloku
; Argumenty: Wstawiony blok
; Wynik: Lista słownik łączący nazwy atrybutów i objekty je reprezentujące
;----------------------------------------------------------
(setq Attr (vlax-invoke-method Blok 'GetAttributes ) )
(setq AttrList(vlax-safearray->list(vlax-variant-value Attr)))
(foreach % AttrList
; (setq %(nth 0 AttrList))
(setq OutList (append OutList (list(cons (vlax-get-property % 'TagString ) %))))
)
OutList
)
(defun C:Oznacz ( / Px BLDef Blok )
(setq Px (XGetpoint "Wskaż punkt" nil nil) ) ; prosi o wskazanie punktu
(if Px (progn
(setq BLDef(BlokOpisowy)) ; definiuje blok opisowy
(setq Blok (vlax-invoke-method *Model* 'InsertBlock (vlax-3d-point Px ) (vlax-get-property BLDef 'Name ) 1 1 1 0)) ; wstawia blok
(setq Atrs (Atrybuty Blok )) ; funkcja pobierająca atrybuty z bloku
(vlax-put-property (cdr(assoc "X" Atrs)) 'TextString (rtos (car Px) 2 2)) ; zmiana wartości atrybutu
(vlax-put-property (cdr(assoc "Y" Atrs)) 'TextString (rtos (cadr Px) 2 2))
))
)
Wykonanie w ZWCAD 2023
Wykonanie w ZWCAD 2015
