;Rysowanie linii o długości równiej długości zaznaczonego obiektu


(vl-load-com)

(setq *ZWCAD* (vlax-get-acad-object))
(setq *Rysunek* (vla-get-activedocument *ZWCAD*))
(setq *Model* (vla-get-Modelspace *Rysunek*))
(defun r2d (rad /)
;----------------------------------------------------------
;funkcja zamienia wartość kąta zapisaną w radianach na jej odpowiednik w stopniach
;Argumenty: liczba, wartość kąta w radianach
;Wynik: liczba, wartość kąta w stopniach
;----------------------------------------------------------
(/ (* rad 180.0) pi)
)

(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:ObLenLine( / Len element Obj ObjType P1)
;----------------------------------------------------------
; funkcja Rysuje we wskazanym punkcie linię o długości równej długości wskazanego elementu
; Argumenty: nil
; Wynik: nil
;----------------------------------------------------------

(setq element(entsel "\nwskaż obiekt wzorcowy") )
(if element
(progn
(setq element( car element) )
(setq Obj (vlax-ename->vla-object element))
(setq ObjType(vlax-get-property Obj "EntityName"))
(cond
((= "AcDbArc" ObjType) (setq Len (vlax-get-property Obj 'ArcLength ) ))
((= "AcDbCircle" ObjType) (setq Len (vlax-get-property Obj 'Circumference ) ))
((= "AcDbPolyline" ObjType) (setq Len (vlax-get-property Obj 'Length ) ))
( T (print ObjType ))
)
(if Len(progn

(setq P1(XGetpoint "\nwskaż punkt wstawienia linii" nil nil))
(if P1 (progn
(vlax-invoke-method *Model* 'AddLine (vlax-3d-point P1 )
(vlax-3d-point (list (+ (car P1) Len) (cadr P1)(caddr P1)) ) )
))
))
))
)

Wykonanie w ZWCAD 2015+LISP ObLenLine 2015