Need help with modifying a lisp routine

Need help with modifying a lisp routine

Anonymous
Not applicable
255 Views
1 Reply
Message 1 of 2

Need help with modifying a lisp routine

Anonymous
Not applicable

I have a free download lisp routine by Lee Mac that I need help modifying it for our use.

 

The routine places the distane of a line in text at the mid point of a selected line.

 

Does anyone know how to modify this routine so that it will place the text "above" the selected line and also add the foot mark ' at the end of the distance (example 245.45').

 

Here is the routine:

 

(defun c:PLL ( / *error* spc i ss e Der p obj )
(vl-load-com)
;; Lee Mac ~ 29.04.10

(defun *error* ( msg )
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **")))
(princ)
)

(setq spc
(if
(or
(eq AcModelSpace
(vla-get-ActiveSpace
(setq doc
(vla-get-ActiveDocument
(vlax-get-acad-object)
)
)
)
)
(eq :vlax-true (vla-get-MSpace doc))
)
(vla-get-ModelSpace doc)
(vla-get-PaperSpace doc)
)
)

(if (setq i -1 ss (ssget '((0 . "CIRCLE,ARC,LINE,*POLYLINE"))))

(while (setq e (ssname ss (setq i (1+ i))))
(setq Der
(angle '(0. 0. 0.)
(vlax-curve-getFirstDeriv e
(vlax-curve-getParamatPoint e
(setq p (MidPoint e))
)
)
)
)

(setq Obj
(MCMText spc p 0.
(strcat "%<\\AcObjProp Object(%<\\_ObjId "
(GetObjectID (vlax-ename->vla-object e) doc) ">%)."
(cond
(
(eq "CIRCLE" (setq typ (cdr (assoc 0 (entget e)))))
"Circumference"
)
(
(eq "ARC" typ)
"ArcLength"
)
(
"Length"
)
)
" \\f \"%lu6\">%"
)
)
)

(vla-put-rotation Obj (MakeReadable Der))

(vla-put-BackgroundFill obj :vlax-true)
)
)
(princ)
)

(defun MCMText (block point width string / o)
(vla-put-AttachmentPoint
(setq o (vla-AddMText block
(vlax-3D-point point) width string))
acAttachmentPointMiddleCenter)

(vla-put-InsertionPoint o (vlax-3D-point point))

o)

(defun MakeReadable ( a )
(cond
(
(and (> a (/ pi 2)) (<= a pi))

(- a pi)
)
(
(and (> a pi) (<= a (/ (* 3 pi) 2)))

(+ a pi)
)
(
a
)
)
)

(defun GetObjectID ( obj doc )
(if
(eq "X64"
(strcase
(getenv "PROCESSOR_ARCHITECTURE")
)
)
(vlax-invoke-method
(vla-get-Utility doc) 'GetObjectIdString obj :vlax-false
)
(itoa (vla-get-Objectid obj))
)
)

(defun MidPoint ( e )
(vlax-curve-getPointatDist e
(/
(vlax-curve-getDistatParam e
(vlax-curve-getEndParam e)
)
2.
)
)
)

0 Likes
256 Views
1 Reply
Reply (1)
Message 2 of 2

leothebuilder
Advisor
Advisor

Ask this question in the customization forum, you'll get a better response there:

 

http://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/bd-p/130

0 Likes