;;; Draw length of multi Lines, Arcs, Circles and Ellipses as Masked Mtext
;;; Saved from here: http://www.cadtutor.net/forum/showthread.php?56656-Lisp-help-Selecting-multi-lines-and-labeling-them/page2

(defun c:lm(/ aDoc cTxt eLen ePar iAng iDr lPnt lSet oldSize sPar tWid lCol
cLay nTxt Precision Suffix BackMask Layer Color)

; *****************************************************************************
; ADJUSTMENTS ;
; (Modify it to adjust for your own requirements) ;
; *****************************************************************************

(setq Precision 1) ; - precision of measurement (digits after decimal point)

(setq Suffix "m") ; - Suffix after measirement for ex. "'" or "" for none

(setq BackMask 1.0) ; - Background mask borders from 1.0 to 10.0
; or nil for none. Reocomended value 1.0.
; !!! nil for versions ealer AutoCAD 2005 !!!

(setq Layer "0-Length-Calculation") ; - layer of markers or nil for current layer

(setq Color 1) ; - color of layer for ex. 1 (Red)

; ******************************* END ADJUSTMENTS *****************************

(vl-load-com)

(defun Add_Masked_MText(Str Pt Hei Wid wiF Ang Mask
/ oOsn cLay cTxt actSp nTxt
oDxf nDxf mPt xPt aDoc aSp lFlg)

; (Add_Masked_MText )

(setq oOsn(getvar "OSMODE")
aDoc(vla-get-ActiveDocument
(vlax-get-acad-object))
cLay (vla-get-ActiveLayer aDoc)
aSp(vla-get-ActiveSpace aDoc)
); end setq
(if(= 1 aSp)
(setq aSp(vla-get-ModelSpace aDoc))
(setq aSp(vla-get-PaperSpace aDoc))
); end if
(if(= :vlax-true(vla-get-Lock cLay))
(progn
(vla-put-Lock cLay :vlax-false)
(setq lFlg T)
); end progn
); end if
(if(= 1.0 wiF)
(setq cTxt(strcat "\\pxqc;" Str))
(setq cTxt(strcat "\\pxqc;{\\W" (rtos wiF) ";" Str "}"))
); end if
(setq nTxt(vla-AddMText aSp
(vlax-3D-point '(0.0 0.0 0.0)) 1.0 cTxt))
(vla-put-Height nTxt Hei)
(vla-put-Width nTxt(+ Wid(/ Hei 2)))
(if Mask
(progn
(vla-put-BackgroundFill nTxt -1)
(setq oDxf(entget(vlax-vla-object->ename nTxt))
nDxf(subst (cons 45 Mask)(assoc 45 oDxf)oDxf)
); end setq
(entmod nDxf)
); end progn
); end if
(vla-getBoundingBox nTxt 'mPt 'xPt)
(setq mPt(vlax-safearray->list mPt)
xPt(vlax-safearray->list xPt)
mPt(vlax-3d-point
(list(+(car mPt)(/(-(car xPt)(car mPt))2))
(+(cadr mPt)(/(-(cadr xPt)(cadr mPt))2))
0.0))
); end setq
(vla-Move nTxt mPt(vlax-3D-point Pt))
(if(and(> Ang 0)(<= Ang pi))
(vla-Rotate nTxt(vlax-3D-point Pt)(- Ang(/ pi 2)))
(vla-Rotate nTxt(vlax-3D-point Pt)(+ Ang(/ pi 2)))
); end if
(if lFlg
(vla-put-Lock cLay :vlax-true)
); end if
nTxt
); end of Add_Masked_MText

(if(not lab:Size)(setq lab:Size(getvar "TEXTSIZE")))
(setq oldSize lab:Size
lab:Size
(getreal
(strcat "\nText size : ")))
(if(null lab:Size)(setq lab:Size oldSize))
(princ "\n<<>> ")
(if(setq lSet(ssget '((0 . "*LINE,ARC,ELLIPSE,CIRCLE"))))
(progn
(setq aDoc(vla-get-ActiveDocument(vlax-get-acad-object))
lCol(vla-get-Layers aDoc)
); end setq
(vla-StartUndoMark aDoc)
(if Layer
(if(vl-catch-all-error-p
(vl-catch-all-apply
'vla-Item(list lCol Layer)))
(progn
(setq cLay(vla-Add lCol Layer))
(vla-put-Color cLay Color)
); end progn
); end if
); end if
(foreach l(vl-remove-if 'listp(mapcar 'cadr(ssnamex lSet)))
(setq sPar(vlax-curve-getStartParam l)
ePar(vlax-curve-getEndParam l)
eLen(-(vlax-curve-getDistAtParam l ePar)
(vlax-curve-getDistAtParam l sPar))
lPnt(vlax-curve-getPointAtDist l(/ eLen 2))
iDr(vlax-curve-getFirstDeriv l
(vlax-curve-getParamAtPoint l lPnt))
iAng(- pi
(atan
(/(car iDr)
(if(= 0.0(cadr iDr))(* 2 pi)(cadr iDr)))))
cTxt(strcat(rtos eLen 2 Precision)Suffix)
tWid(caadr
(textbox
(list(cons 1 cTxt)
(cons 40 lab:Size)(cons 41 0.8))))
); end setq
(setq nTxt(Add_Masked_MText cTxt lPnt lab:Size (+ tWid(/ lab:Size 3)) 0.8 iAng BackMask))
(if Layer
(vla-put-Layer nTxt Layer)
); end if
(vla-EndUndoMark aDoc)
); end foreach
); end progn
(princ "\n Nothing selected ")
); end if
(princ)
); end of c:lmark
(c:lm)

Advertisements