Wyrównanie widoku

Szczegóły: Kategoria: Przykłady LISP; Opublikowano: 08 październik 2012

W tym przykładzie chciałbym przedstawić w jaki sposób można obracać przestrzenią widoczną w arkuszu. Przykładowy program poprosi użytkownika o wskazanie pary punktów, a następnie wyrówna widok tak, by linia łącząca wskazane punkty była równoległa do krawędzi kartki.

Wyrównanie widoku

Polecenie do uruchomienia skryptu LISP: WyrownajW

Kod źródłowy z opisem

;;; Wyrównanie widoku
;;; zwcad.pl
;;; Polecenie do uruchomienia skryptu LISP: WyrownajW
;;; Opis: https://www.zwcad.pl/materialy-edukacyjne/kurs-lisp/przyklady-lisp/203-wyrownanie-widoku.html

(vl-load-com)
(setq *ZWCAD* (vlax-get-acad-object))
(setq *Rysunek* (vla-get-activedocument *ZWCAD* ))
(defun XGetpoint (tresc P0 domyslny / )
;----------------------------------------------------------
;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 Odl(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 Odl(vl-catch-all-apply 'getpoint (list tresc )))
)
(if (vl-catch-all-error-p Odl) ; sprawdzenie czy zwrócony został obiekt błędu
(progn ; wystąpił błąd
(prompt (vl-catch-all-error-message Odl)) ;wyświetla w pasku poleceń komumikat błędu
(setq Wynik nil )
)
(progn ; Użytkownik wskazał punkt lub [ENTER]/[SPACE]
(if (null Odl)
(setq Wynik domyslny )
(setq Wynik Odl)
)
)
)
Wynik
)
(defun C:WyrownajW ( / ActPViewPort P1 P2 rotangle)
;----------------------------------------------------------
; funkcja służy obracaniu widoku na arkuszu. Użytkownik powinien przejść do arkusza, aktywować model
; dwukreotni klikając wewnątrz wybranego widoku, uruchomić funkcję i wskazać dwa punkty. Przestrzeń
; widoczna w widoku zostanie obrócona tak, by wskazane punkty były równoległe do krawędzi kartki
;----------------------------------------------------------
(setq ActPViewPort(vl-catch-all-apply 'vlax-get-property (list *Rysunek* 'ActivePViewport )))
(if (not(vl-catch-all-error-p ActPViewPort))(progn
(setq P1 (XGetpoint "\nWskaż pierwszy punkt" nil nil))
; (print P1 )
(if P1 (progn
(setq P2 (XGetpoint "\nWskaż drugi punkt" P1 nil))
(if P2 (progn
(setq rotangle (-(angle P1 P2))) ;obliczenie nachylenia pomiędzy wskazanymi punktami
(setq LastCenter (vlax-get-property ActPViewPort 'Target ) ); zapisanie środka obszaru widocznego w widoku
(vlax-put-property ActPViewPort 'TwistAngle rotangle ) ; ustawienie kąta obrotu widoku
(vlax-put-property ActPViewPort 'Target LastCenter) ; przywrócenie środka widoku
(vlax-invoke-method ActPViewPort 'Update )
(vlax-invoke-method *Rysunek* 'Regen ZcActiveViewport )
))
))
)
(princ "Aktywuj widok w arkuszu")
)
(princ)
)