Need help with modifying a lisp routine

- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
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.
)
)
)