Jump to content

Polyline lenght in block attribute


sakinen

Recommended Posts

I need a lisp routine for extracting polyline length (selected one) and that value needs to be copied into block attribute (i also need to select one).

 

I have a lisp routine witch does similar job. It measures lenghts and sum of them puts in an attribute.

 

Heres the code:

(defun c:MacDis (/ scl pt lst dis dLst grdata gr dat ent)
 (vl-load-com)
 (setq scl 1.)

 (if (setq pt (getpoint "\nSelect Point: "))
   (progn
     (setq lst (cons pt lst))
     (while
       (progn
         (initget "Scale")
         (setq pt
           (getpoint (car lst) "\nSelect Point [scale]: "))
         (cond ((eq 'LIST (type pt))
                (setq dis (distance pt (car lst))
                      lst (cons pt lst) dLst (cons (* scl dis) dLst))
                (princ
                  (strcat "\n<{:: Distance: " (rtos dis)
                    (if (= scl 1.) ""
                      (strcat " :: After Scaling: " (rtos (* scl dis))))
                          " :: Total: " (rtos (apply '+ dLst)) " ::}>")) t)
               ((eq "Scale" pt)
                (initget 6)
                (or (setq scl (getreal "\nSpecify Scale Factor <1.0>: "))
                    (setq scl 1.)))
               (t nil))))
     (if (and dLst
           (setq msg (princ "\nSelect Attribute: ")))
       (while
         (progn
           (setq grdata (grread 't 13 2)
                 gr (car grdata) dat (cadr grdata))
           (cond ((and (eq 3 gr) (listp dat))
                  (if (and (setq ent (car (nentselp dat)))
                           (eq "ATTRIB" (cdr (assoc 0 (entget ent)))))
                    (vla-put-TextString
                      (vlax-ename->vla-object ent)
                        (rtos (apply '+ dLst)))
                    (princ (strcat "\n** Object Not an Attribute **" msg))))
                 ((or (eq 25 gr)
                      (and (eq 2 gr)
                           (vl-position dat '(13 32))))
                  (princ "\n** User Quit **") nil) (t)))))))
 (princ))

Thanks in advance.

Link to comment
Share on other sites

Here is simple routine for you

No error trapping though

(vl-load-com)
(defun c:ALE (/ atent attobj ent leng obj) 
     (while
(setq ent
       (entsel "\nSelect Polyline (or press eEnter to Exit): "))
 (setq obj (vlax-ename->vla-object (car ent)))
 (setq leng (rtos
       (vlax-get-property obj "Length")
       2
       3      ; <--precison 3 decimals
       )
       )
 (if
   (setq atent
   (nentsel "\nSelect Attribute: "))
    (progn
      (setq attobj (vlax-ename->vla-object (car atent)))
      (vlax-put-property attobj "TextString" leng)
      )
    )
 )
 (princ)
 )
(prompt "\nStart command with ALE")
(prin1)

 

~'J'~

Link to comment
Share on other sites

Thanks a lot. This is realy simplistic aproach. Always the best one... Im trying to put scale factor for a lenght value and multiply it by 2. Its supposed to measure double pipe runs.

Link to comment
Share on other sites

You could also use a field...

 

(defun c:L2T (/ curve obj)
 ;; Alan J. Thompson, 06.24.10
 (if (and (setq curve (car (AT:GetSel entsel
                                      "\nSelect LWPolyline: "
                                      (lambda (x) (eq "LWPOLYLINE" (cdr (assoc 0 (entget (car x))))))
                           )
                      )
          )
          (setq obj (car (AT:GetSel nentsel
                                    "\nSelect text object to place value: "
                                    (lambda (x)
                                      (vlax-property-available-p
                                        (vlax-ename->vla-object (car x))
                                        'TextString
                                      )
                                    )
                         )
                    )
          )
     )
   (vl-catch-all-apply
     (function vla-put-textstring)
     (list (vlax-ename->vla-object obj)
           (strcat "%<\\AcObjProp Object(%<\\_ObjId "
                   (itoa (vla-get-objectID (vlax-ename->vla-object curve)))
                   ">%).Length \\f \"%lu2%pr2\">%"
           )
     )
   )
 )
 (princ)
)

(defun AT:GetSel (meth msg fnc / ent good)
 ;; meth - selection method (entsel, nentsel, nentselp)
 ;; msg - message to display (nil for default)
 ;; fnc - optional function to apply to selected object
 ;; Ex: (AT:GetSel entsel "\nSelect arc: " (lambda (x) (eq (cdr (assoc 0 (entget (car x)))) "ARC")))
 ;; Alan J. Thompson, 05.25.10
 (setvar 'errno 0)
 (while (not good)
   (setq ent (meth (cond (msg)
                         ("\nSelect object: ")
                   )
             )
   )
   (cond
     ((vl-consp ent)
      (setq good (if (or (not fnc) (fnc ent))
                   ent
                   (prompt "\nInvalid object!")
                 )
      )
     )
     ((eq (type ent) 'STR) (setq good ent))
     ((setq good (eq 52 (getvar 'errno))) nil)
     ((eq 7 (getvar 'errno)) (setq good (prompt "\nMissed, try again.")))
   )
 )
)

Link to comment
Share on other sites

Thanks a lot. This is realy simplistic aproach. Always the best one... Im trying to put scale factor for a lenght value and multiply it by 2. Its supposed to measure double pipe runs.

 

Just multyplied on 2:

 

 
(vl-load-com)
(defun c:ALE (/ atent attobj ent leng obj) 
     (while
(setq ent
       (entsel "\nSelect Polyline (or press eEnter to Exit): "))
 (setq obj (vlax-ename->vla-object (car ent)))
 (setq leng (rtos
       (* 2 (vlax-get-property obj "Length")); <--multiply on 2
       2
       3      ; <--precison 3 decimals
       )
       )
 (if
   (setq atent
   (nentsel "\nSelect Attribute: "))
    (progn
      (setq attobj (vlax-ename->vla-object (car atent)))
      (vlax-put-property attobj "TextString" leng)
      )
    )
 )
 (princ)
 )
(prompt "\nStart command with ALE")
(prin1)

 

~'J'~

Link to comment
Share on other sites

did the same thing. Thanks a lot anyway!

Please, attach your drawing here to see where is a problem

(I use A2009)

 

~'J'~

Link to comment
Share on other sites

  • 2 months later...
Here is simple routine for you

No error trapping though

(vl-load-com)
(defun c:ALE (/ atent attobj ent leng obj) 
     (while
(setq ent
       (entsel "\nSelect Polyline (or press eEnter to Exit): "))
 (setq obj (vlax-ename->vla-object (car ent)))
 (setq leng (rtos
       (vlax-get-property obj "Length")
       2
       3      ; <--precison 3 decimals
       )
       )
 (if
   (setq atent
   (nentsel "\nSelect Attribute: "))
    (progn
      (setq attobj (vlax-ename->vla-object (car atent)))
      (vlax-put-property attobj "TextString" leng)
      )
    )
 )
 (princ)
 )
(prompt "\nStart command with ALE")
(prin1)

 

~'J'~

 

If i understand this right its exactly the same thing as I want to do, but as its my first time using LISP can someone break this down for me so I can customise it to my needs.

 

Tried to copy exactly, but I get an error straight away and have no idea where to start dissecting to fix.

 

Thanks in advance.

Link to comment
Share on other sites

Not sure if this helps, but I had fun writing it anyway:

 

(defun c:Len2Fld ( / *error* tables doc spc p s q ExitFlag )
 (vl-load-com)
 ;; © Lee Mac 2010

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

 (setq tables (LM:ss->vla (ssget "_X" '((0 . "ACAD_TABLE")))))

 (LM:ActiveSpace 'doc 'spc)   

 (cond
   (
     (setq p
       (LM:Selectif
         (lambda ( x )
           (vlax-property-available-p
             (vlax-ename->vla-object x) 'Length
           )
         )
         "\nSelect Object: " nil
       )
     )
     (setq s
       (strcat "%<\\AcObjProp Object(%<\\_ObjId "
         (LM:GetObjectID doc (vlax-ename->vla-object p)) ">%).Length \\f \"%lu6\">%"
       )
     )         
     (while
       (progn
         (or ExitFlag
           (progn
             (initget "Point")
             (setq p (nentsel "\nSelect Text, MText or Attribute for Result [Point] <Exit> : "))
           )
         )
        
         (cond
           (
             ExitFlag nil
           )
           (
             (vl-consp p)
           
             (if (wcmatch (cdr (assoc 0 (entget (car p)))) "ATTRIB,*TEXT")
               (vla-put-TextString (vlax-ename->vla-object (car p)) s)
               (princ "\n** Object Must be Text, MText or Attribute **")
             )
           )
           (
             (eq "Point" p)

             (while
               (progn
                 (initget "Object")
                 (setq q (getpoint "\nSpecify Point for Field [Object] <Exit> : "))

                 (cond
                   (
                     (vl-consp q)

                     (cond
                       ( (LM:TextinCell tables q s) )
                       (
                         (setq o (vla-AddMText spc (vlax-3D-point (trans q 1 0)) 0 s))

                         (vla-put-AttachmentPoint o acAttachmentPointMiddleCenter)
                         (vla-put-InsertionPoint o (vlax-3D-point (trans q 1 0)))
                       )
                     )
                     (setq ExitFlag t) nil
                   )
                   (
                     (eq  "Object"  q) nil
                   )
                   (
                     (setq ExitFlag t) nil
                   )
                 )
               )
             )
            t
           )
         )
       )
     )
   )
 )
 (vla-regen doc AcActiveViewport)
 (princ)
)                      
                         
;;--------------------=={ ActiveSpace }==---------------------;;
;;                                                            ;;
;;  Retrieves pointers to the Active Document and Space       ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010                               ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  *doc - quoted symbol other than *doc                      ;;
;;  *spc - quoted symbol other than *spc                      ;;
;;------------------------------------------------------------;;

(defun LM:ActiveSpace ( *doc *spc )
 ;; © Lee Mac 2010
 (set *spc
   (if
     (or
       (eq AcModelSpace
         (vla-get-ActiveSpace
           (set *doc
             (vla-get-ActiveDocument
               (vlax-get-acad-object)
             )
           )
         )
       )
       (eq :vlax-true (vla-get-MSpace (eval *doc)))
     )
     (vla-get-ModelSpace (eval *doc))
     (vla-get-PaperSpace (eval *doc))
   )
 )
)

;;---------------------=={ Select if }==----------------------;;
;;                                                            ;;
;;  Continuous selection prompts until the predicate function ;;
;;  foo is validated                                          ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010                               ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  foo  - predicate function taking ename argument           ;;
;;  str  - prompt string                                      ;;
;;  nest - boolean flag determining use of nested selection   ;;
;;------------------------------------------------------------;;
;;  Returns:  selected entity ename if successful, else nil   ;;
;;------------------------------------------------------------;;

(defun LM:Selectif ( foo str nest / e )
 ;; © Lee Mac 2010
 (while
   (progn
     (setq e (car ((if nest nentsel entsel) str)))
     
     (cond
       (
         (eq 'ENAME (type e))

         (if (not (foo e)) (princ "\n** Invalid Object Selected **"))
       )
     )
   )
 )
 e
)

;;-------------------=={ Get Object ID }==--------------------;;
;;                                                            ;;
;;  Returns a string containing the ObjectID for the          ;;
;;  specified VLA-Object                                      ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010                               ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  doc - VLA Document Object                                 ;;
;;  obj - VLA Object for which to return the Object ID        ;;
;;------------------------------------------------------------;;
;;  Returns:  String containing the ObjectID for 'obj'        ;;
;;------------------------------------------------------------;;

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

;;-------------------=={ Text in Cell }==---------------------;;
;;                                                            ;;
;;  If specified point lies inside a table cell, cell text is ;;
;;  set to the specified string.                              ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010                               ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  tables - a list of VLA Table Objects to be checked        ;;
;;  pt     - a 3D Point                                       ;;
;;  str    - a string to populate the cell                    ;;
;;------------------------------------------------------------;;
;;  Returns:  T if text is allocated into a cell, else nil    ;;
;;------------------------------------------------------------;;

(defun LM:TextinCell ( tables pt str / data )
 ;; © Lee Mac 2010
 (if
   (setq data
     (vl-some
       (function
         (lambda ( table )
           (if
             (eq :vlax-true
               (vla-hittest table (vlax-3D-point (trans pt 1 0))
                 (vlax-3D-point (trans (getvar 'VIEWDIR) 1 0)) 'row 'col
               )
             )
             (list table row col)
           )
         )
       )
       tables
     )
   )
   (not
     (apply (function vla-setText)
       (append data (list str))
     )
   )
 )
)

;;-----------------=={ SelectionSet -> VLA }==----------------;;
;;                                                            ;;
;;  Converts a SelectionSet to a list of VLA Objects          ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010                               ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  ss - Valid SelectionSet (Pickset)                         ;;
;;------------------------------------------------------------;;
;;  Returns:  List of VLA Objects                             ;;
;;------------------------------------------------------------;;

(defun LM:ss->vla ( ss )
 ;; © Lee Mac 2010
 (if ss
   (
     (lambda ( i / e l )
       (while (setq e (ssname ss (setq i (1+ i))))
         (setq l (cons (vlax-ename->vla-object e) l))
       )
       l
     )
     -1
   )
 )
)

 

Will place result as a FIELD in either Text, MText, Attribute or Table, or as a new MText Object.

Link to comment
Share on other sites

Thanks Lee,

 

A little bit over my head at the moment though.

 

Although, I have made some progress with fixos code. I have it working just need to make a small tweek. Is it possible to use a selection window to select multiple polylines and add the length of them all together instead of just the one line?

 

Is there a reference any where of all lisp commands?

Link to comment
Share on other sites

Here is how I might code that:

 

(defun c:addlen ( / ss )
 (vl-load-com)
 ;; © Lee Mac 2010

 (if (setq ss (ssget '((0 . "LINE,*POLYLINE"))))
   (
     (lambda ( i total / e )
       (while (setq e (ssname ss (setq i (1+ i))))
         (setq total (+ total (vla-get-length (vlax-ename->vla-object e))))
       )

       (princ (strcat "\n<< Length: " (rtos total) " >>"))
     )
     -1 0
   )
 )

 (princ)
)

My code steps through the selection set of lines and polylines and adds the length of each VLA Object cumulatively, printing the result at the end.

 

For a reference, I suggest you open a new ACAD Drawing and type VLIDE at the command line, then go to File > New File.

 

Here you can start typing code, and for help on a function, double-click it to highlight it then click on the beige speech bubble button (help) for help on that function.

 

Note that help for the VLA-* functions is written for VBA, but can be easily translated to VLISP as all the arguements, their type and order apply.

 

For completeness, to update my original code to allow for multiple selection:

 

(defun c:Len2Fld ( / *error* tables doc spc ss p s q ExitFlag )
 (vl-load-com)
 ;; © Lee Mac 2010

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

 (setq tables (LM:ss->vla (ssget "_X" '((0 . "ACAD_TABLE")))))

 (LM:ActiveSpace 'doc 'spc)   

 (cond
   (
     (setq ss (LM:ss->vla (ssget '((0 . "LINE,*POLYLINE")))))
     (setq s
       (if (= 1 (length ss))
         (strcat "%<\\AcObjProp Object(%<\\_ObjId " (LM:GetObjectID doc (car ss)) ">%).Length \\f \"%lu6\">%")
         (strcat "%<\\AcExpr %<\\AcObjProp Object(%<\\_ObjId "
           (LM:lst->str
             (mapcar
               (function
                 (lambda ( x ) (LM:GetObjectID doc x))
               )
               ss
             )
             ">%).Length>% + %<\\AcObjProp Object(%<\\_ObjId "
           )
           ">%).Length>% \\f \"%lu6\">%"
         )
       )
     )
     (while
       (progn
         (or ExitFlag
           (progn
             (initget "Point")
             (setq p (nentsel "\nSelect Text, MText or Attribute for Result [Point] <Exit> : "))
           )
         )
        
         (cond
           (
             ExitFlag nil
           )
           (
             (vl-consp p)
           
             (if (wcmatch (cdr (assoc 0 (entget (car p)))) "ATTRIB,*TEXT")
               (vla-put-TextString (vlax-ename->vla-object (car p)) s)
               (princ "\n** Object Must be Text, MText or Attribute **")
             )
           )
           (
             (eq "Point" p)

             (while
               (progn
                 (initget "Object")
                 (setq q (getpoint "\nSpecify Point for Field [Object] <Exit> : "))

                 (cond
                   (
                     (vl-consp q)

                     (cond
                       ( (LM:TextinCell tables q s) )
                       (
                         (setq o (vla-AddMText spc (vlax-3D-point (trans q 1 0)) 0 s))

                         (vla-put-AttachmentPoint o acAttachmentPointMiddleCenter)
                         (vla-put-InsertionPoint o (vlax-3D-point (trans q 1 0)))
                       )
                     )
                     (setq ExitFlag t) nil
                   )
                   (
                     (eq  "Object"  q) nil
                   )
                   (
                     (setq ExitFlag t) nil
                   )
                 )
               )
             )
            t
           )
         )
       )
     )
   )
 )
 (vla-regen doc AcActiveViewport)
 (princ)
)                      
                         
;;--------------------=={ ActiveSpace }==---------------------;;
;;                                                            ;;
;;  Retrieves pointers to the Active Document and Space       ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010                               ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  *doc - quoted symbol other than *doc                      ;;
;;  *spc - quoted symbol other than *spc                      ;;
;;------------------------------------------------------------;;

(defun LM:ActiveSpace ( *doc *spc )
 ;; © Lee Mac 2010
 (set *spc
   (if
     (or
       (eq AcModelSpace
         (vla-get-ActiveSpace
           (set *doc
             (vla-get-ActiveDocument
               (vlax-get-acad-object)
             )
           )
         )
       )
       (eq :vlax-true (vla-get-MSpace (eval *doc)))
     )
     (vla-get-ModelSpace (eval *doc))
     (vla-get-PaperSpace (eval *doc))
   )
 )
)

;;-------------------=={ Get Object ID }==--------------------;;
;;                                                            ;;
;;  Returns a string containing the ObjectID for the          ;;
;;  specified VLA-Object                                      ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010                               ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  doc - VLA Document Object                                 ;;
;;  obj - VLA Object for which to return the Object ID        ;;
;;------------------------------------------------------------;;
;;  Returns:  String containing the ObjectID for 'obj'        ;;
;;------------------------------------------------------------;;

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

;;-------------------=={ Text in Cell }==---------------------;;
;;                                                            ;;
;;  If specified point lies inside a table cell, cell text is ;;
;;  set to the specified string.                              ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010                               ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  tables - a list of VLA Table Objects to be checked        ;;
;;  pt     - a 3D Point                                       ;;
;;  str    - a string to populate the cell                    ;;
;;------------------------------------------------------------;;
;;  Returns:  T if text is allocated into a cell, else nil    ;;
;;------------------------------------------------------------;;

(defun LM:TextinCell ( tables pt str / data )
 ;; © Lee Mac 2010
 (if
   (setq data
     (vl-some
       (function
         (lambda ( table )
           (if
             (eq :vlax-true
               (vla-hittest table (vlax-3D-point (trans pt 1 0))
                 (vlax-3D-point (trans (getvar 'VIEWDIR) 1 0)) 'row 'col
               )
             )
             (list table row col)
           )
         )
       )
       tables
     )
   )
   (not
     (apply (function vla-setText)
       (append data (list str))
     )
   )
 )
)

;;-----------------=={ SelectionSet -> VLA }==----------------;;
;;                                                            ;;
;;  Converts a SelectionSet to a list of VLA Objects          ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010                               ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  ss - Valid SelectionSet (Pickset)                         ;;
;;------------------------------------------------------------;;
;;  Returns:  List of VLA Objects                             ;;
;;------------------------------------------------------------;;

(defun LM:ss->vla ( ss )
 ;; © Lee Mac 2010
 (if ss
   (
     (lambda ( i / e l )
       (while (setq e (ssname ss (setq i (1+ i))))
         (setq l (cons (vlax-ename->vla-object e) l))
       )
       l
     )
     -1
   )
 )
)

;;-------------------=={ List to String }==-------------------;;
;;                                                            ;;
;;  Constructs a string from a list of strings separating     ;;
;;  each element by a specified delimiter                     ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010                               ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  lst - a list of strings to process                        ;;
;;  del - delimiter by which to separate each list element    ;;
;;------------------------------------------------------------;;
;;  Returns:  String containing each string in the list       ;;
;;------------------------------------------------------------;;

(defun LM:lst->str ( lst del )
 ;; © Lee Mac 2010
 (if (cdr lst)
   (strcat (car lst) del (LM:lst->str (cdr lst) del))
   (car lst)
 )
)

Lee

Link to comment
Share on other sites

(defun c:Len (/ ss)
 ;; Alan J. Thompson, 08.28.10
 (if (setq ss (ssget '((0 . "ARC,*LINE"))))
   ((lambda (i v / e)
      (while (setq e (ssname ss (setq i (1+ i))))
        (setq v (+ v (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e))))
      )
      (alert (princ (strcat "\nTotal length: " (rtos v))))
    )
     -1
     0.
   )
 )
 (princ)
)

Link to comment
Share on other sites

  • 2 years later...
Here is simple routine for you

No error trapping though

(vl-load-com)
(defun c:ALE (/ atent attobj ent leng obj) 
     (while
(setq ent
       (entsel "\nSelect Polyline (or press eEnter to Exit): "))
 (setq obj (vlax-ename->vla-object (car ent)))
 (setq leng (rtos
       (vlax-get-property obj "Length")
       2
       3      ; <--precison 3 decimals
       )
       )
 (if
   (setq atent
   (nentsel "\nSelect Attribute: "))
    (progn
      (setq attobj (vlax-ename->vla-object (car atent)))
      (vlax-put-property attobj "TextString" leng)
      )
    )
 )
 (princ)
 )
(prompt "\nStart command with ALE")
(prin1)

~'J'~

 

 

Hi,

 

I need the same lisp to update the length of the PL in the designated field of the block.

 

Thanking you in advance,

 

Jayaram.C.V.

Link to comment
Share on other sites

  • 2 years later...

Could somebody tell me how also divide by 2 ( /2) the length and then attach it to attribute in this code

(vl-load-com) (defun c:ALE (/ atent attobj ent leng obj)        (while  (setq ent         (entsel "\nSelect Polyline (or press eEnter to Exit): "))   (setq obj (vlax-ename->vla-object (car ent)))   (setq leng (rtos         (vlax-get-property obj "Length")         2         3      ; <--precison 3 decimals         )         )   (if     (setq atent     (nentsel "\nSelect Attribute: "))      (progn        (setq attobj (vlax-ename->vla-object (car atent)))        (vlax-put-property attobj "TextString" leng)        )      )   )   (princ)   ) (prompt "\nStart command with ALE") (prin1)

Link to comment
Share on other sites

(defun c:ALE (/ atent attobj ent leng obj)
 (vl-load-com)
 (while (setq ent (entsel "\nSelect Polyline (or press eEnter to Exit): "))
   (setq obj (vlax-ename->vla-object (car ent)))
   (setq leng (rtos
     [color=red](/ (vlax-get-property obj "Length") 2.0) ; <--length divided by 2.0[/color]
       2
       3      ; <--precison 3 decimals
     )
   )
   (if (setq atent (nentsel "\nSelect Attribute: "))
     (progn
       (setq attobj (vlax-ename->vla-object (car atent)))
       (vlax-put-property attobj "TextString" leng)
     )
   )
 )
 (princ)
)
(prompt "\nStart command with ALE")
(prin1)

Link to comment
Share on other sites

  • 1 month later...

Hi all,

 

I need your help in writing a lisp that inserts a pre-defined block (e.g. "Xtag" attached herein) in the middle of a polyline and to write the length of this polyline in one of its attributes (e.g. "Length").

The lisp should allow for multiple selection. I am attaching the block Xtag and a reference drawing to be used as a template.

 

Thank you in advance!

 

Nasr

XTag.dwg

FG-CHW.dwg

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.

×
×
  • Create New...