@inaamazmi
can i change the text angle from 0 degree to 33 degree?
try to start creating this lisp and i'll be here to help
well i understand you still have difficulty to start such a lisp so i jumped in 😀
attach beautiful command (called it) LEA-DER imitating standard LEADER command but the text content is aligned to the last landing segment.
the leader arrow size + mtext height is taken from the current running dimension style variables DIMASZ & DIMTXT and scale is controlled by DIMSCALE just the same as done by the standard command. make sure to properly set the dimension style.
the program starts with a loop (while) to draw short lines segments at finish, the short lines is replaced by pline that have an arrow head, than goes to a second loop pausing for you to enter leader texts contents and then the mtext is aligned to last segment.
note the use of some anonymous functions (i call them 'stabbing' functions) their objectivity is to process data and return a value makes the code readable and well structured 😀
Moshe
(vl-load-com) ; load ActiveX support
; custom leader
; support ucs rotate about Z axis only
(defun c:lea-der (/ break askpoint drawLine asktext _content _space _midseg _readang ucs->wcs ; local functions
acadobj adoc DIMASZ DIMTXT DIMSCL ss points^ p0 p1
str strings^ base wth text MTextObj MinPoint MaxPoint)
(defun break (msg)
(if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
(princ (strcat "\nError: " msg))
)
(vla-endUndoMark adoc)
(setvar "cmdecho" 1)
(vlax-release-object adoc)
(setq *error* nil)
(princ)
); break
(defun askpoint (anchor)
(apply
'getpoint
(if (not anchor)
(list "\nSpecify leader start point: ")
(list anchor "\nSpecify leader next point: ")
)
)
); askpoint
(defun drawLine ()
(command "._line" (cadr points^) (car points^) "")
(ssadd (entlast) ss)
); drawLine
(defun asktext (def)
(apply 'getstring (list (strcat "\nEnter " (if (not def) "first" "next") " line of annotation: ")))
); asktext
; =============== anonymous functions ================================
; generate mtext content
(setq _content (lambda (lst) (substr (apply 'strcat (mapcar (function (lambda (str) (strcat "\\P" str))) lst)) 3)))
; return paper space or model space object
(setq _space (lambda () (if (= (getvar "cvport") 1) (vla-get-paperSpace adoc) (vla-get-modelSpace adoc))))
; return 1/2 mtext box height
(setq _midseg (lambda (v1 v2) (* 0.5 (abs (apply '- (mapcar (function (lambda (v0) (car (vlax-safearray->list v0)))) (list v1 v2)))))))
; return readable text angle
(setq _readang (lambda (ang) (if (and (> ang (/ pi 2)) (< ang (* pi 1.5))) (+ ang pi) ang)))
; convert points from ucs to wcs
(setq ucs->wcs (lambda (lst) (mapcar (function (lambda (pt) (trans pt 1 0))) lst)))
; here start (c:lea-der)
(setq *error* break) ; error handler
(setq acadObj (vlax-get-acad-object))
(setq adoc (vla-get-ActiveDocument acadObj))
(vla-startUndoMark adoc)
(setvar "cmdecho" 0)
; define some constants
(setq DIMASZ (getvar "dimasz"))
(setq DIMTXT (getvar "dimtxt"))
(setq DIMSCL (getvar "dimscale"))
; =============== draw temporary short lines ============================
(setq ss (ssadd))
(cond
((progn
(while (setq p0 (askpoint p0))
(setq points^ (cons p0 points^))
(cond
((= (vl-list-length points^) 1)) ; do noting
((= (vl-list-length points^) 2)
(cond
; first segment length must comply to 2 x DIMASZ
((< (distance (cadr points^) (car points^)) (* 2 DIMASZ))
(setq points^ (cdr points^) p0 (car points^))
(vlr-beep-reaction)
(prompt "\nFirst segment too short, must be 2 times arrow size.")
); case
( t
(drawLine)
); case
); cond
); case
( t
(drawLine)
); case
); cond
); while
(command ".erase" "_si" ss) ; remove teporary lines
); progn
); case
((> (vl-list-length points^) 2)
; ================= replace lines by pline ============================
(setq points^ (reverse points^))
(setq p0 (car points^) p1 (cadr points^))
(command "._pline" p0 "_width" 0.0 (* (/ DIMASZ 3) DIMSCL)
(polar p0 (angle p0 p1) (* DIMASZ DIMSCL)) "_width" 0 0)
(foreach pt (cdr points^)
(command pt)
)
(command "") ; finish pline
; ================= pause for leader contents===========================
(while (/= (setq str (asktext str)) "")
(setq strings^ (cons str strings^))
); while
(setq points^ (ucs->wcs points^)) ; convert points to wcs
; ======================= Add MText ====================================
(setq base (vlax-3d-point (last points^)))
(setq wth (* (car (vl-sort (_width (reverse strings^)) '>)) DIMSCL))
(setq text (_content (reverse strings^)))
(setq MTextObj (vla-AddMText (_space) base wth text))
(vla-put-height MTextObj (* DIMTXT DIMSCL))
(vla-getBoundingBox MTextObj 'MinPoint 'MaxPoint)
(setq p0 (cadr (reverse points^)) p1 (car (reverse points^)))
(vla-put-attachmentpoint MTextObj acAttachmentPointMiddleCenter)
(vla-put-insertionpoint MTextObj (vlax-3d-point (polar p1 (angle p0 p1) (+ (/ DIMASZ 3) (_midseg MinPoint MaxPoint)))))
; rotate mtext
(vla-put-rotation MTextObj (_readang (- (angle p0 p1) (atan (cadr (getvar "ucsxdir")) (car (getvar "ucsxdir"))))))
(vlax-release-object MTextObj)
); case
); cond
(setvar "cmdecho" 1)
(vla-endUndoMark adoc)
(vlax-release-object adoc)
(setq *error* nil) ; reset
(princ)
); c:lea-der
