(vl-load-com)

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

(defun C:WymiarKat ( / CMDEcho P0 P1 P2 P0Glob P1Glob P2Glob AktualnyUCS LokP0 LokP1 LokP2 LokTekstPt GlobTekstPt)
;----------------------------------------------------------
; funkcja rysuje wymiar kątowy na podstawie wskazanych trzech puntów w przestrzeni
; Argumenty:
; Wynik
;----------------------------------------------------------

(setq CMDEcho(getvar "cmdecho" ) )  ;zmienna ta jest potrzebna, by zablokować wyświetlanie treści w pasku poleceń w czasie używania funkcji (command
(setvar "cmdecho" 0)       ;blokujemy wyświetlanie treści

(setq P0 (XGetpoint "\nPodaj wierzchołek kąta" nil nil))
(if P0
(progn
(setq P1 (XGetpoint "\nPodaj pierwszy punkt końcowy kąta:" P0 nil))
(if P1
(progn
(setq P2 (XGetpoint "\nPodaj drugi punkt końcowy kąta:" P0 nil))
(if P2
(progn
(setq P0Glob (trans P0 1 0)) ; konwersja współrzędnych z lokalnego do globalnego układu współrzędnych
(setq P1Glob (trans P1 1 0))
(setq P2Glob (trans P2 1 0))

(setq AktualnyUCS (PobierzUCS)) ; zachowujemy stan aktualnego układu współrzędnych
(UCS3Pts P0Glob P1Glob P2Glob) ; ustawiamy układ współrzędnych do wskazanych punktów

(setq LokP0 (trans P0Glob 0 1)) ; konwersja współrzędnych z globalnego do lokalnego układu współrzędnych
(setq LokP1 (trans P1Glob 0 1))
(setq LokP2 (trans P2Glob 0 1))

(setq LokTekstPt (polar LokP0
(+ (angle LokP0 LokP1) ;angle: oblicza kąt nachylenia prostej zdefiniowanej przez dwa punkty
(/ (- (angle LokP0 LokP2) ; względem osi OX lokalnego układu współrzędnych
(angle LokP0 LokP1))
2.0))
(distance LokP0 LokP1))) ; oblicza odległość pomiędzy parą punktów
(setq GlobTekstPt (trans LokTekstPt 1 0))

(command "_dimangular" "" LokP0 LokP1 LokP2 LokTekstPt)

(UCS3Pts (car AktualnyUCS) (cadr AktualnyUCS) (caddr AktualnyUCS))
 (setvar "cmdecho" CMDEcho)  

; na koniec przywracamy poprzedni stan zmiennej. Nie jest to konieczne, należy jednak wprowadzać jak najmniej zmian w konfiguracji ZWCADa  przez programy zewnętrzne. 


)
)
)
)
)

)
)

(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ń 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 PobierzUCS ( / )
;----------------------------------------------------------
;funkcja pobiera aktualny układ współrzędnych
;Argumenty: brak
;Wynik: lista: - Środek układu współrzędnych
; - Kierunek osi X
; - Kierunek osi Y
; punkty zwracamy w jednostkach układu globalnego
;----------------------------------------------------------
(list (trans(getvar "UCSOrg") 1 0) (trans (getvar "UCSXDir") 1 0) (trans (getvar "UCSYDir") 1 0))
)
(defun UCS3Pts (P0 Px Py / )
;----------------------------------------------------------
;Funkcja ustawia aktualny układ współrzędnych na podstawie trzech punktów
;Argumenty:
; P0 - środek nowego układu współrzędnych
; Px - Kierunek osi X nowego układu
; Py - Kierunek osi Y nowego układu
; współrzędne podajemy w układzie globalnym
;Wynik :brak
;----------------------------------------------------------

(command "_UCS" "_n" "3" (trans P0 0 1) (trans Px 0 1)(trans Py 0 1) )
nil
)

Wykonanie w ZWCAD 2015+LISP WymiarKat 2015

Wykonanie w ZWCAD ClassicLISP WymiarKat Classic