Jump to content

Lines Auto Dimensioning

Fire Alarm

By Fire Alarm
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

Lee Mac Grand Master

Lee Mac

Posted
Posted

Does this help:

 

;; ============ pLen.lsp ===============
;;
;;  FUNCTION:
;;  Will Display the Length of a
;;  Line or Polyline upon selection.
;;
;;  SYNTAX: pLen
;;
;;  AUTHOR:
;;  Copyright (c) 2009, Lee McDonnell
;;  (Contact Lee Mac, CADTutor.net)
;;
;;
;;  VERSION:
;;  1.0  ~  30.06.2009
;;
;; ====================================


(defun c:pLen (/ *error* doc spc ent cObj tStr tSze
                tBox wBse gr cPt pt cAng lAng)
 (vl-load-com)

 (defun *error* (msg)
   (and tObj
     (not
       (vlax-erased-p tObj))
         (vla-delete tObj))
   (if
     (not
       (wcmatch
         (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))
     (princ
       (strcat
         "\n<< Error: " msg " >>")))
   (princ))

  (if
    (eq 4
      (logand 4
        (cdr (assoc 70
               (tblsearch "LAYER"
                 (getvar "CLAYER"))))))
   (progn
     (princ "\n<< Current Layer Locked >>") (exit)))

 (setq doc (vla-get-ActiveDocument
             (vlax-get-Acad-Object))
       spc (if
             (zerop
               (vla-get-activespace doc))
             (if (= (vla-get-mspace doc) :vlax-true)
               (vla-get-modelspace doc)
               (vla-get-paperspace doc))
             (vla-get-modelspace doc)))
 
 (while
   (progn
     (setq ent
       (car (entsel "\nSelect Object: ")))
     (cond
       ((eq 'ENAME (type ent))
        (setq cObj (vlax-ename->vla-object ent))
        (if (vlax-property-available-p cObj 'length)
          (not
            (print
              (setq tStr
                (rtos
                  (vla-get-length cObj) 3 2))))
          (princ "\n** Invalid Object Selected **")))
       (t (princ "\n** Nothing Selected **")))))

 (or *Mac$Per*  (setq *Mac$Per* (/ pi 2.)))
 (or *Mac$tOff* (setq *Mac$tOff* 1.))
 (or tSze (setq tSze (getvar "TEXTSIZE")))

 (setq tBox (textbox
              (list
                (cons 1 (strcat tStr ".."))
                (cons 40 tSze)
                (cons 7 (getvar "TEXTSTYLE"))))
       wBse (textbox
              (list
                (cons 1 ".")
                (cons 40 tSze)
                (cons 7 (getvar "TEXTSTYLE"))))
       wBse (- (caadr wBse) (caar wBse)))
           
       (vla-put-attachmentpoint
         (setq tObj
           (vla-addMText spc
             (vlax-3D-point '(0 0 0))
               (setq tWid (- (caadr tBox) (caar tBox))) tStr))
         acAttachmentPointMiddleCenter)
     (vla-put-Height tObj tSze)
     (princ "\n<< Type [+] or [-] for offset, [P]er & [<] or [>] for MText Width  >>")

     ;; Place Text
           
     (while
       (or
         (and
           (setq gr (grread t 15 0))
             (eq (car gr) 5))
         (and
           (eq 2 (car gr))
           (vl-position (cadr gr)
             '(43 ; +
               45 ; -
               61 ; + (as =)
               80 112  ; P/p
               60 62 44 46)))) ; < > , .
       
       (cond ((and (eq 5 (car gr)) (listp (setq cPt (cadr gr))))
              (setq pt (vlax-curve-getClosestPointto cObj cPt)
                    cAng (angle pt cPt)
                    lAng (+ cAng *Mac$Per*))
              
              (cond ((and (> lAng (/ pi 2)) (<= lAng pi))
                     (setq lAng (- lAng pi)))
                    ((and (> lAng pi) (<= lAng (/ (* 3 pi) 2)))
                     (setq lAng (+ lAng pi))))
              
              (vla-move tObj
                (vla-get-InsertionPoint tObj)
                  (vlax-3D-point
                    (polar pt cAng (* tSze *Mac$tOff*))))
              (vla-put-Rotation tObj lAng))

             ((eq 2 (car gr))
              (cond ((vl-position (cadr gr) '(43 61))
                     (setq *Mac$tOff*
                       (+ (/ 1 10.) *Mac$tOff*)))
                    ((eq (cadr gr) 45)
                     (setq *Mac$tOff*
                       (-  *Mac$tOff* (/ 1 10.))))
                    ((vl-position (cadr gr) '(80 112))
                     (setq *Mac$Per* (- (/ pi 2.) *Mac$Per*)))
                    ((vl-position (cadr gr) '(60 44))
                     (if (> (- (vla-get-Width tObj) wBse) 0)
                       (vla-put-Width tObj
                         (- (vla-get-Width tObj) wBse))))
                    ((vl-position (cadr gr) '(62 46))
                     (vla-put-Width tObj
                       (+ (vla-get-Width tObj) wBse)))))))
 (princ))

(princ
 (strcat "\nCurve Length by Lee McDonnell " (chr 169) " June 2009."
         "\n         Type \"PLEN\" to Invoke"))
(princ)

Link to comment
Share on other sites
  • Replies 37
  • Created
  • Last Reply

Top Posters In This Topic

  • Lee Mac

    14

  • Fire Alarm

    12

  • chelsea1307

    4

  • scwoo

    3

Popular Days

Top Posters In This Topic

Popular Days

Fire Alarm Collaborator

Fire Alarm

Posted
  • Author
Posted

Yeah that works great. Now one more question for you. Just to be a pain in the ***. Can a command be added to select multiple plines, and have the lengths of each individual pline?

 

Also, where would I be able to find tutorials on creating lisps?

Link to comment
Share on other sites
Lee Mac Grand Master

Lee Mac

Posted
Posted
Yeah that works great. Now one more question for you. Just to be a pain in the ***. Can a command be added to select multiple plines, and have the lengths of each individual pline?

 

This can be done, but the text placement would not be automatic. And also, this is no small task.

 

Also, where would I be able to find tutorials on creating lisps?

 

Check out AfraLISP, Jeffery Sanders, Ron Leigh etc

Link to comment
Share on other sites
Fire Alarm Collaborator

Fire Alarm

Posted
  • Author
Posted

Ok if it can be done, then I think I will make a project for myself once I get the hang of creating lisps. I have a template that counts all of my blocks for whatever drawing I extract attributes from and import them into my excel template. I was thinking that if I could extract the plinne lengths in to that template, then all I would have to do is cut and paste the lengths right into my voltage drop calc template. And save about and hours worth of work. Thank you for all of your help, I greatly appreciate it. I will checks those sites that you recommended.

Link to comment
Share on other sites
BlackAlnet Enthusiast

BlackAlnet

Posted
Posted

Wow Lee, that's a big complicated lisp. I'm lunch time, but i never realize do something so complete and sofisticated

Link to comment
Share on other sites
Fire Alarm Collaborator

Fire Alarm

Posted
  • Author
Posted

I agree, it is amazing what one can do with knowledge and an imagination. There is in my mind definitely no limit to what one can do.

Link to comment
Share on other sites
Lee Mac Grand Master

Lee Mac

Posted
Posted

Thanks Guys,

 

This uses FIELDS if it is of any use:

 

;; ============ pLen.lsp ===============
;;
;;  FUNCTION:
;;  Will Display the Length of a
;;  Line or Polyline upon selection.
;;
;;  SYNTAX: pLen
;;
;;  AUTHOR:
;;  Copyright (c) 2009, Lee McDonnell
;;  (Contact Lee Mac, CADTutor.net)
;;
;;
;;  VERSION:
;;  1.0  ~  30.06.2009
;;
;; ====================================


(defun c:pLen (/ *error* doc spc ent cObj tStr tSze
                tBox wBse gr cPt pt cAng lAng)
 (vl-load-com)

 (defun *error* (msg)
   (and tObj
     (not
       (vlax-erased-p tObj))
         (vla-delete tObj))
   (if
     (not
       (wcmatch
         (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))
     (princ
       (strcat
         "\n<< Error: " msg " >>")))
   (princ))

  (if
    (eq 4
      (logand 4
        (cdr (assoc 70
               (tblsearch "LAYER"
                 (getvar "CLAYER"))))))
   (progn
     (princ "\n<< Current Layer Locked >>") (exit)))

 (setq doc (vla-get-ActiveDocument
             (vlax-get-Acad-Object))
       spc (if
             (zerop
               (vla-get-activespace doc))
             (if (= (vla-get-mspace doc) :vlax-true)
               (vla-get-modelspace doc)
               (vla-get-paperspace doc))
             (vla-get-modelspace doc)))
 
 (while
   (progn
     (setq ent
       (car (entsel "\nSelect Object: ")))
     (cond
       ((eq 'ENAME (type ent))
        (setq cObj (vlax-ename->vla-object ent))
        (if (vlax-property-available-p cObj 'length)
          (not
            (setq tStr
              (strcat "%<\\AcObjProp Object(%<\\_ObjId "
                (vl-princ-to-string
                  (vla-get-objectid cObj))
                    ">%).Length \\f \"%lu2%pr2\">%")))
          (princ "\n** Invalid Object Selected **")))
       (t (princ "\n** Nothing Selected **")))))

 (or *Mac$Per*  (setq *Mac$Per* (/ pi 2.)))
 (or *Mac$tOff* (setq *Mac$tOff* 1.))
 (or tSze (setq tSze (getvar "TEXTSIZE")))

 (setq tBox (textbox
              (list
                (cons 1 (strcat tStr ".."))
                (cons 40 tSze)
                (cons 7 (getvar "TEXTSTYLE"))))
       wBse (textbox
              (list
                (cons 1 ".")
                (cons 40 tSze)
                (cons 7 (getvar "TEXTSTYLE"))))
       wBse (- (caadr wBse) (caar wBse)))
           
       (vla-put-attachmentpoint
         (setq tObj
           (vla-addMText spc
             (vlax-3D-point '(0 0 0))
               (setq tWid (- (caadr tBox) (caar tBox))) tStr))
         acAttachmentPointMiddleCenter)
     (vla-put-Height tObj tSze)
     (vl-cmdf "_updatefield" (entlast) "")
     (princ "\n<< Type [+] or [-] for offset, [P]er & [<] or [>] for MText Width  >>")

     ;; Place Text
           
     (while
       (or
         (and
           (setq gr (grread t 15 0))
             (eq (car gr) 5))
         (and
           (eq 2 (car gr))
           (vl-position (cadr gr)
             '(43 ; +
               45 ; -
               61 ; + (as =)
               80 112  ; P/p
               60 62 44 46)))) ; < > , .
       
       (cond ((and (eq 5 (car gr)) (listp (setq cPt (cadr gr))))
              (setq pt (vlax-curve-getClosestPointto cObj cPt)
                    cAng (angle pt cPt)
                    lAng (+ cAng *Mac$Per*))
              
              (cond ((and (> lAng (/ pi 2)) (<= lAng pi))
                     (setq lAng (- lAng pi)))
                    ((and (> lAng pi) (<= lAng (/ (* 3 pi) 2)))
                     (setq lAng (+ lAng pi))))
              
              (vla-move tObj
                (vla-get-InsertionPoint tObj)
                  (vlax-3D-point
                    (polar pt cAng (* tSze *Mac$tOff*))))
              (vla-put-Rotation tObj lAng))

             ((eq 2 (car gr))
              (cond ((vl-position (cadr gr) '(43 61))
                     (setq *Mac$tOff*
                       (+ (/ 1 10.) *Mac$tOff*)))
                    ((eq (cadr gr) 45)
                     (setq *Mac$tOff*
                       (-  *Mac$tOff* (/ 1 10.))))
                    ((vl-position (cadr gr) '(80 112))
                     (setq *Mac$Per* (- (/ pi 2.) *Mac$Per*)))
                    ((vl-position (cadr gr) '(60 44))
                     (if (> (- (vla-get-Width tObj) wBse) 0)
                       (vla-put-Width tObj
                         (- (vla-get-Width tObj) wBse))))
                    ((vl-position (cadr gr) '(62 46))
                     (vla-put-Width tObj
                       (+ (vla-get-Width tObj) wBse)))))))
 (princ))

(princ
 (strcat "\nCurve Length by Lee McDonnell " (chr 169) " June 2009."
         "\n         Type \"PLEN\" to Invoke"))
(princ)

Link to comment
Share on other sites
Lee Mac Grand Master

Lee Mac

Posted
Posted

As a quick modification, this may work for multiple selection of lines:

 

(defun c:pLen2 (/ *error* doc spc ss mid tStr tBox tObj lAng)
 (vl-load-com)

 (defun *error* (msg)
   (if
     (not
       (wcmatch
         (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))
     (princ
       (strcat
         "\n<< Error: " msg " >>")))
   (princ))

  (if
    (eq 4
      (logand 4
        (cdr (assoc 70
               (tblsearch "LAYER"
                 (getvar "CLAYER"))))))
   (progn
     (princ "\n<< Current Layer Locked >>") (exit)))

 (setq doc (vla-get-ActiveDocument
             (vlax-get-Acad-Object))
       spc (if
             (zerop
               (vla-get-activespace doc))
             (if (= (vla-get-mspace doc) :vlax-true)
               (vla-get-modelspace doc)
               (vla-get-paperspace doc))
             (vla-get-modelspace doc)))
 
 (while (not ss)
   (setq ss (ssget '((0 . "*LINE")))))
 (setq tSze (getvar "DIMTXT"))

 (foreach Obj
   (mapcar 'vlax-ename->vla-object
     (vl-remove-if 'listp
       (mapcar 'cadr (ssnamex ss))))
   (setq tStr (rtos (vla-get-length Obj) 3 2)
         tBox (textbox
                (list
                  (cons 1 (strcat tStr ".."))
                  (cons 40 tSze)
                  (cons 7 (getvar "TEXTSTYLE")))))
   (setq mid (/ (abs (- (vlax-curve-getEndParam Obj)
                          (vlax-curve-getStartParam Obj))) 2.)
         lAng (angle '(0 0 0) (vlax-curve-getFirstDeriv Obj mid)))
   (cond ((and (> lAng (/ pi 2)) (<= lAng pi))
      (setq lAng (- lAng pi)))
     ((and (> lAng pi) (<= lAng (/ (* 3 pi) 2)))
      (setq lAng (+ lAng pi))))
     (setq tObj
       (vla-addMText spc
         (vlax-3D-point (vlax-curve-getPointatParam Obj mid))
           (- (caadr tBox) (caar tBox)) tStr))
   (vla-put-Height tObj tSze)
   (vla-put-Rotation tObj lAng))
 (princ))

Link to comment
Share on other sites
  • 2 years later...
scwoo Newbie

scwoo

Posted
Posted
As a quick modification, this may work for multiple selection of lines:

 

(defun c:pLen2 (/ *error* doc spc ss mid tStr tBox tObj lAng)
 (vl-load-com)

 (defun *error* (msg)
   (if
     (not
       (wcmatch
         (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))
     (princ
       (strcat
         "\n<< Error: " msg " >>")))
   (princ))

  (if
    (eq 4
      (logand 4
        (cdr (assoc 70
               (tblsearch "LAYER"
                 (getvar "CLAYER"))))))
   (progn
     (princ "\n<< Current Layer Locked >>") (exit)))

 (setq doc (vla-get-ActiveDocument
             (vlax-get-Acad-Object))
       spc (if
             (zerop
               (vla-get-activespace doc))
             (if (= (vla-get-mspace doc) :vlax-true)
               (vla-get-modelspace doc)
               (vla-get-paperspace doc))
             (vla-get-modelspace doc)))
 
 (while (not ss)
   (setq ss (ssget '((0 . "*LINE")))))
 (setq tSze (getvar "DIMTXT"))

 (foreach Obj
   (mapcar 'vlax-ename->vla-object
     (vl-remove-if 'listp
       (mapcar 'cadr (ssnamex ss))))
   (setq tStr (rtos (vla-get-length Obj) 3 2)
         tBox (textbox
                (list
                  (cons 1 (strcat tStr ".."))
                  (cons 40 tSze)
                  (cons 7 (getvar "TEXTSTYLE")))))
   (setq mid (/ (abs (- (vlax-curve-getEndParam Obj)
                          (vlax-curve-getStartParam Obj))) 2.)
         lAng (angle '(0 0 0) (vlax-curve-getFirstDeriv Obj mid)))
   (cond ((and (> lAng (/ pi 2)) (<= lAng pi))
      (setq lAng (- lAng pi)))
     ((and (> lAng pi) (<= lAng (/ (* 3 pi) 2)))
      (setq lAng (+ lAng pi))))
     (setq tObj
       (vla-addMText spc
         (vlax-3D-point (vlax-curve-getPointatParam Obj mid))
           (- (caadr tBox) (caar tBox)) tStr))
   (vla-put-Height tObj tSze)
   (vla-put-Rotation tObj lAng))
 (princ))

 

Hi Lee,

 

Thank you so much for posting this lisp as I have been searching for it to ease my husband's job for the past few days. In fact i'm totally new to autocad, just less than a week old to it. I've been trying find some useful tools to help reduce my hubby's workload and glad that i found lisp & your post. :D

 

We tried this lisp and it is just what we need except that it is set to imprerial/architectural format, how could we change it to metric/decimal? We only manage to adjust the textsize :oops:

 

Hope you can help or guide us to modify the code. Thanks.

 

SC

Link to comment
Share on other sites
Lee Mac Grand Master

Lee Mac

Posted
Posted
Thank you so much for posting this lisp as I have been searching for it to ease my husband's job for the past few days. In fact i'm totally new to autocad, just less than a week old to it. I've been trying find some useful tools to help reduce my hubby's workload and glad that i found lisp & your post. :D

 

We tried this lisp and it is just what we need except that it is set to imprerial/architectural format, how could we change it to metric/decimal? We only manage to adjust the textsize :oops:

 

Wow, that is some very old code of mine! I'm glad it is still useful :)

 

Here is an 'updated version', it will create Fields to display the length, or plain MText (depending on the settings at the top of the code).

 

It should hopefully also work in all UCS/Views:

 

[color=GREEN];; Length Text  -  Lee Mac[/color]
[color=GREEN];; Displays the Length of a Line / Polyline / LWPolyline at its midpoint.[/color]
[color=GREEN];; Program will create MText field or plain MText, depending on the setting of 'field' variable.[/color]

([color=BLUE]defun[/color] c:LenTxt ( [color=BLUE]/[/color] *error* acdoc acspc an en field fieldstr format i nm ob pa pt readable ss ts )

   [color=GREEN];; ----------------- Adjustments ----------------- ;;[/color]

   ([color=BLUE]setq[/color] field [color=BLUE]t[/color]       [color=GREEN];; t = create field / nil = plain MText[/color]
         format [color=MAROON]"%lu6"[/color] [color=GREEN];; Field Formatting[/color]
   )

   [color=GREEN];; ----------------------------------------------- ;;[/color]

   ([color=BLUE]defun[/color] *error* ( msg )
       ([color=BLUE]if[/color] ([color=BLUE]not[/color] ([color=BLUE]wcmatch[/color] ([color=BLUE]strcase[/color] msg) [color=MAROON]"*BREAK,*CANCEL*,*EXIT*"[/color]))
           ([color=BLUE]princ[/color] ([color=BLUE]strcat[/color] [color=MAROON]"\nError: "[/color] msg))
       )
       ([color=BLUE]princ[/color])
   )

   ([color=BLUE]setq[/color] acdoc ([color=BLUE]vla-get-activedocument[/color] ([color=BLUE]vlax-get-acad-object[/color]))
         acspc ([color=BLUE]vlax-get-property[/color] acdoc ([color=BLUE]if[/color] ([color=BLUE]=[/color] 1 ([color=BLUE]getvar[/color] 'CVPORT)) 'paperspace 'modelspace))
   )
   ([color=BLUE]if[/color] field
       ([color=BLUE]setq[/color] fieldstr
           ([color=BLUE]eval[/color]
               ([color=BLUE]list[/color] '[color=BLUE]lambda[/color] '( obj )
                   ([color=BLUE]list[/color] '[color=BLUE]strcat[/color] [color=MAROON]"%<\\AcObjProp Object(%<\\_ObjId "[/color]
                       ([color=BLUE]if[/color] ([color=BLUE]vl-string-search[/color] [color=MAROON]"64"[/color] ([color=BLUE]getenv[/color] [color=MAROON]"PROCESSOR_ARCHITECTURE"[/color]))
                           ([color=BLUE]list[/color] '[color=BLUE]vla-getobjectidstring[/color] ([color=BLUE]vla-get-utility[/color] acdoc) 'obj '[color=BLUE]:vlax-false[/color])
                          '([color=BLUE]itoa[/color] ([color=BLUE]vla-get-objectid[/color] obj))
                       )
                       [color=MAROON]">%).Length \\f \""[/color] format [color=MAROON]"\">%"[/color]
                   )
               )
           )
       )
   )
   ([color=BLUE]setq[/color] readable
       ([color=BLUE]eval[/color]
           ([color=BLUE]list[/color] '[color=BLUE]lambda[/color] '( a )
               ([color=BLUE]list[/color]
                   ([color=BLUE]list[/color] '[color=BLUE]lambda[/color] '( a )
                       ([color=BLUE]list[/color] '[color=BLUE]-[/color]
                          '([color=BLUE]if[/color] ([color=BLUE]and[/color] ([color=BLUE]<[/color] ([color=BLUE]/[/color] [color=BLUE]pi[/color] 2.0) a) ([color=BLUE]<=[/color] a ([color=BLUE]/[/color] ([color=BLUE]*[/color] 3.0 [color=BLUE]pi[/color]) 2.0)))
                               ([color=BLUE]+[/color] a [color=BLUE]pi[/color])
                               a
                           )
                           ([color=BLUE]angle[/color] '(0. 0. 0.) ([color=BLUE]trans[/color] ([color=BLUE]getvar[/color] 'UCSXDIR) 0 ([color=BLUE]trans[/color] '(0. 0. 1.) 1 0 [color=BLUE]t[/color]) [color=BLUE]t[/color]))
                       )
                   )
                  '([color=BLUE]rem[/color] ([color=BLUE]+[/color] a [color=BLUE]pi[/color] [color=BLUE]pi[/color]) ([color=BLUE]+[/color] [color=BLUE]pi[/color] [color=BLUE]pi[/color]))
               )
           )
       )
   )
   ([color=BLUE]cond[/color]
       (   ([color=BLUE]=[/color] 4 ([color=BLUE]logand[/color] 4 ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 70 ([color=BLUE]tblsearch[/color] [color=MAROON]"LAYER"[/color] ([color=BLUE]getvar[/color] 'CLAYER))))))
           ([color=BLUE]princ[/color] [color=MAROON]"\nCurrent Layer Locked."[/color])
       )
       (   ([color=BLUE]null[/color] ([color=BLUE]setq[/color] ss ([color=BLUE]ssget[/color] '((0 . [color=MAROON]"LINE,*POLYLINE"[/color])))))
           ([color=BLUE]princ[/color] [color=MAROON]"\n*Cancel*"[/color])
       )
       (   [color=BLUE]t[/color]
           ([color=BLUE]setq[/color] nm ([color=BLUE]trans[/color] '(0. 0. 1.) 1 0 [color=BLUE]t[/color])
                 ts ([color=BLUE]getvar[/color] 'TEXTSIZE)
           )         
           ([color=BLUE]repeat[/color] ([color=BLUE]setq[/color] i ([color=BLUE]sslength[/color] ss))
               ([color=BLUE]setq[/color] en ([color=BLUE]ssname[/color] ss ([color=BLUE]setq[/color] i ([color=BLUE]1-[/color] i)))
                     pa ([color=BLUE]/[/color] ([color=BLUE]vlax-curve-getendparam[/color] en) 2.0)
                     an ([color=BLUE]angle[/color] '(0. 0. 0.) ([color=BLUE]trans[/color] ([color=BLUE]vlax-curve-getfirstderiv[/color] en pa) 0 nm))
                     pt ([color=BLUE]vlax-3D-point[/color]
                            ([color=BLUE]trans[/color]
                                ([color=BLUE]polar[/color]
                                    ([color=BLUE]trans[/color] ([color=BLUE]vlax-curve-getpointatparam[/color] en pa) 0 1)
                                    ([color=BLUE]+[/color] an ([color=BLUE]/[/color] [color=BLUE]pi[/color] 2.0))
                                    ts
                                )
                                1 0
                            )
                        )
               )
               ([color=BLUE]setq[/color] ob
                   ([color=BLUE]vla-addmtext[/color] acspc pt 0.0
                       ([color=BLUE]if[/color] field
                           (fieldstr ([color=BLUE]vlax-ename->vla-object[/color] en))
                           ([color=BLUE]rtos[/color] ([color=BLUE]vlax-curve-getdistatparam[/color] en ([color=BLUE]vlax-curve-getendparam[/color] en)))
                       )
                   )
               )
               ([color=BLUE]vla-put-attachmentpoint[/color] ob [color=BLUE]acattachmentpointmiddlecenter[/color])
               ([color=BLUE]vla-put-insertionpoint[/color] ob pt)
               ([color=BLUE]vla-put-rotation[/color] ob (readable an))
           )
       )
   )
   ([color=BLUE]princ[/color])
)
([color=blue]vl-load-com[/color]) ([color=blue]princ[/color])

Link to comment
Share on other sites
scwoo Newbie

scwoo

Posted
Posted
Wow, that is some very old code of mine! I'm glad it is still useful :)

 

Here is an 'updated version', it will create Fields to display the length, or plain MText (depending on the settings at the top of the code).

 

It should hopefully also work in all UCS/Views:

 

[color=GREEN];; Length Text  -  Lee Mac[/color]
[color=GREEN];; Displays the Length of a Line / Polyline / LWPolyline at its midpoint.[/color]
[color=GREEN];; Program will create MText field or plain MText, depending on the setting of 'field' variable.[/color]

([color=BLUE]defun[/color] c:LenTxt ( [color=BLUE]/[/color] *error* acdoc acspc an en field fieldstr format i nm ob pa pt readable ss ts )

   [color=GREEN];; ----------------- Adjustments ----------------- ;;[/color]

   ([color=BLUE]setq[/color] field [color=BLUE]t[/color]       [color=GREEN];; t = create field / nil = plain MText[/color]
         format [color=MAROON]"%lu6"[/color] [color=GREEN];; Field Formatting[/color]
   )

   [color=GREEN];; ----------------------------------------------- ;;[/color]

   ([color=BLUE]defun[/color] *error* ( msg )
       ([color=BLUE]if[/color] ([color=BLUE]not[/color] ([color=BLUE]wcmatch[/color] ([color=BLUE]strcase[/color] msg) [color=MAROON]"*BREAK,*CANCEL*,*EXIT*"[/color]))
           ([color=BLUE]princ[/color] ([color=BLUE]strcat[/color] [color=MAROON]"\nError: "[/color] msg))
       )
       ([color=BLUE]princ[/color])
   )

   ([color=BLUE]setq[/color] acdoc ([color=BLUE]vla-get-activedocument[/color] ([color=BLUE]vlax-get-acad-object[/color]))
         acspc ([color=BLUE]vlax-get-property[/color] acdoc ([color=BLUE]if[/color] ([color=BLUE]=[/color] 1 ([color=BLUE]getvar[/color] 'CVPORT)) 'paperspace 'modelspace))
   )
   ([color=BLUE]if[/color] field
       ([color=BLUE]setq[/color] fieldstr
           ([color=BLUE]eval[/color]
               ([color=BLUE]list[/color] '[color=BLUE]lambda[/color] '( obj )
                   ([color=BLUE]list[/color] '[color=BLUE]strcat[/color] [color=MAROON]"%<\\AcObjProp Object(%<\\_ObjId "[/color]
                       ([color=BLUE]if[/color] ([color=BLUE]vl-string-search[/color] [color=MAROON]"64"[/color] ([color=BLUE]getenv[/color] [color=MAROON]"PROCESSOR_ARCHITECTURE"[/color]))
                           ([color=BLUE]list[/color] '[color=BLUE]vla-getobjectidstring[/color] ([color=BLUE]vla-get-utility[/color] acdoc) 'obj '[color=BLUE]:vlax-false[/color])
                          '([color=BLUE]itoa[/color] ([color=BLUE]vla-get-objectid[/color] obj))
                       )
                       [color=MAROON]">%).Length \\f \""[/color] format [color=MAROON]"\">%"[/color]
                   )
               )
           )
       )
   )
   ([color=BLUE]setq[/color] readable
       ([color=BLUE]eval[/color]
           ([color=BLUE]list[/color] '[color=BLUE]lambda[/color] '( a )
               ([color=BLUE]list[/color]
                   ([color=BLUE]list[/color] '[color=BLUE]lambda[/color] '( a )
                       ([color=BLUE]list[/color] '[color=BLUE]-[/color]
                          '([color=BLUE]if[/color] ([color=BLUE]and[/color] ([color=BLUE]<[/color] ([color=BLUE]/[/color] [color=BLUE]pi[/color] 2.0) a) ([color=BLUE]<=[/color] a ([color=BLUE]/[/color] ([color=BLUE]*[/color] 3.0 [color=BLUE]pi[/color]) 2.0)))
                               ([color=BLUE]+[/color] a [color=BLUE]pi[/color])
                               a
                           )
                           ([color=BLUE]angle[/color] '(0. 0. 0.) ([color=BLUE]trans[/color] ([color=BLUE]getvar[/color] 'UCSXDIR) 0 ([color=BLUE]trans[/color] '(0. 0. 1.) 1 0 [color=BLUE]t[/color]) [color=BLUE]t[/color]))
                       )
                   )
                  '([color=BLUE]rem[/color] ([color=BLUE]+[/color] a [color=BLUE]pi[/color] [color=BLUE]pi[/color]) ([color=BLUE]+[/color] [color=BLUE]pi[/color] [color=BLUE]pi[/color]))
               )
           )
       )
   )
   ([color=BLUE]cond[/color]
       (   ([color=BLUE]=[/color] 4 ([color=BLUE]logand[/color] 4 ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 70 ([color=BLUE]tblsearch[/color] [color=MAROON]"LAYER"[/color] ([color=BLUE]getvar[/color] 'CLAYER))))))
           ([color=BLUE]princ[/color] [color=MAROON]"\nCurrent Layer Locked."[/color])
       )
       (   ([color=BLUE]null[/color] ([color=BLUE]setq[/color] ss ([color=BLUE]ssget[/color] '((0 . [color=MAROON]"LINE,*POLYLINE"[/color])))))
           ([color=BLUE]princ[/color] [color=MAROON]"\n*Cancel*"[/color])
       )
       (   [color=BLUE]t[/color]
           ([color=BLUE]setq[/color] nm ([color=BLUE]trans[/color] '(0. 0. 1.) 1 0 [color=BLUE]t[/color])
                 ts ([color=BLUE]getvar[/color] 'TEXTSIZE)
           )         
           ([color=BLUE]repeat[/color] ([color=BLUE]setq[/color] i ([color=BLUE]sslength[/color] ss))
               ([color=BLUE]setq[/color] en ([color=BLUE]ssname[/color] ss ([color=BLUE]setq[/color] i ([color=BLUE]1-[/color] i)))
                     pa ([color=BLUE]/[/color] ([color=BLUE]vlax-curve-getendparam[/color] en) 2.0)
                     an ([color=BLUE]angle[/color] '(0. 0. 0.) ([color=BLUE]trans[/color] ([color=BLUE]vlax-curve-getfirstderiv[/color] en pa) 0 nm))
                     pt ([color=BLUE]vlax-3D-point[/color]
                            ([color=BLUE]trans[/color]
                                ([color=BLUE]polar[/color]
                                    ([color=BLUE]trans[/color] ([color=BLUE]vlax-curve-getpointatparam[/color] en pa) 0 1)
                                    ([color=BLUE]+[/color] an ([color=BLUE]/[/color] [color=BLUE]pi[/color] 2.0))
                                    ts
                                )
                                1 0
                            )
                        )
               )
               ([color=BLUE]setq[/color] ob
                   ([color=BLUE]vla-addmtext[/color] acspc pt 0.0
                       ([color=BLUE]if[/color] field
                           (fieldstr ([color=BLUE]vlax-ename->vla-object[/color] en))
                           ([color=BLUE]rtos[/color] ([color=BLUE]vlax-curve-getdistatparam[/color] en ([color=BLUE]vlax-curve-getendparam[/color] en)))
                       )
                   )
               )
               ([color=BLUE]vla-put-attachmentpoint[/color] ob [color=BLUE]acattachmentpointmiddlecenter[/color])
               ([color=BLUE]vla-put-insertionpoint[/color] ob pt)
               ([color=BLUE]vla-put-rotation[/color] ob (readable an))
           )
       )
   )
   ([color=BLUE]princ[/color])
)
([color=blue]vl-load-com[/color]) ([color=blue]princ[/color])

 

Hi Lee, thanks for your prompt reply and in deed, the routine is very helpful.

 

I have tested the updated version and it works well too! :lol:

 

I have a few more questions here, hope it won't take up too much of your time:

 

1) I tried to use the Dimension Style Manager to modify the dimension style to "Dimension_Line_TopCurtailment" and reduce the precision to 0 (zero) but it doesn't work. Not sure if this is because the routine was 'hard coded' or did I miss out something? I am using Autocad 2012.

 

(I only managed to change the precision by double clicking the Mtext, right click and select Edit Field, change the format from current unit to decimal and precision to 0. But this way only allow me to change one text at a time instead of changing all at once.)

 

2) How can we add a numbering/prefix in front of the text so that we know the line and its length when we export them to excel (and this is also my 3rd question for you)

 

3) And last, is it possible for us to export the lengths of the lines to excel file?

 

For question 2 & 3, I remember seeing you wrote some routines on similar requests in this forum but couldn't figure out how to use them to modify LenTxt lisp written by you with my very limited knowledge in autocad/lisp. :(

 

Again, thanks for taking your time to answer my questions.

Link to comment
Share on other sites
Lee Mac Grand Master

Lee Mac

Posted
Posted
1) I tried to use the Dimension Style Manager to modify the dimension style to "Dimension_Line_TopCurtailment" and reduce the precision to 0 (zero) but it doesn't work. Not sure if this is because the routine was 'hard coded' or did I miss out something? I am using Autocad 2012.

 

Note that the above programs are not creating Dimensions. They are merely creating MText displaying the length of the selected Lines/Polylines at the respective midpoints.

 

(I only managed to change the precision by double clicking the Mtext, right click and select Edit Field, change the format from current unit to decimal and precision to 0. But this way only allow me to change one text at a time instead of changing all at once.)

 

This can be changed by altering the Field Formatting string at the top of the code ('field' variable). This formatting code can be determined from the Field Expression displayed at the bottom of the Field Dialog. I also describe it in more detail in my 'QuickField' program on my site (format parameter).

 

2) How can we add a numbering/prefix in front of the text so that we know the line and its length when we export them to excel (and this is also my 3rd question for you)

 

Although a prefix can be applied using the Field Formatting, this would be constant, and so a sequential numbering prefix would require a modification to the above program code - not impossible of course.

 

3) And last, is it possible for us to export the lengths of the lines to excel file?

 

For this I would recommend you use the DATAEXTRACTION command, it can do that and lots more...

Link to comment
Share on other sites
scwoo Newbie

scwoo

Posted
Posted
Note that the above programs are not creating Dimensions. They are merely creating MText displaying the length of the selected Lines/Polylines at the respective midpoints.

 

 

 

This can be changed by altering the Field Formatting string at the top of the code ('field' variable). This formatting code can be determined from the Field Expression displayed at the bottom of the Field Dialog. I also describe it in more detail in my 'QuickField' program on my site (format parameter).

 

 

 

Although a prefix can be applied using the Field Formatting, this would be constant, and so a sequential numbering prefix would require a modification to the above program code - not impossible of course.

 

 

 

For this I would recommend you use the DATAEXTRACTION command, it can do that and lots more...

 

 

Lee, again thanks for your clarification on the dimension style and pointing me to the QuickField for further reference. I am so happy to inform that I managed to change the field formatting to %lu2%pr0% after reading the function parameters. 8)

 

Also, managed to extract the data with the DATAEXTRACTION command as recommended. Just need more time to explore more functions. :)

 

Meanwhile, thanks for your assistance and the lisp, it really make our lives much easier! Now, we can spend more time with our kids (although sometimes they prefer to look at angry bird more than us, lol). Will certainly visit your site more for further info.

 

God bless.

Link to comment
Share on other sites
Lee Mac Grand Master

Lee Mac

Posted
Posted
Lee, again thanks for your clarification on the dimension style and pointing me to the QuickField for further reference. I am so happy to inform that I managed to change the field formatting to %lu2%pr0% after reading the function parameters. 8)

 

Also, managed to extract the data with the DATAEXTRACTION command as recommended. Just need more time to explore more functions. :)

 

Meanwhile, thanks for your assistance and the lisp, it really make our lives much easier! Now, we can spend more time with our kids (although sometimes they prefer to look at angry bird more than us, lol). Will certainly visit your site more for further info.

 

God bless.

 

Excellent to hear! I'm really glad you were able to tweak the program to suit your requirements from my brief explanations.

 

I'm happy that it will save you some time in the future. :)

 

Happy Holidays!

 

Lee

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...