autonumbering and lenght

April 21, 2010

Hi, can someone help me? I don't no anything about autolisp and I need a routine that can autonumber and also take the length of a polyne in one time. I also need the possibility of entering a startnumber.

And if it's also possible too, the number and length of the polyline must be placed above and in the middle of the polyline.

Thanks.

April 21, 2010

Would this help?

http://www.cadtutor.net/forum/showthread.php?t=35234

April 21, 2010

Hey Lee Mac, thanks for the lisp. It's almost what I need. Concerning the autonumbering and alignment it's perfect but I still miss the length of the polyline.

See image for more info.

Again thanks for the help.

April 21, 2010

Give this a shot, it uses Fields:

(defun c:PLen ( / *error* doc spc ent uFlag tStr )  
 (vl-load-com)
 ;; Lee Mac  ~  21.04.10

 (defun *error* (msg)
   (and uFlag (vla-EndUndoMark doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))

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

 (setq *num (cond ( *num ) ( 1 ))
       *num (1- (cond ((getint (strcat "\nSpecify Starting Number <" (itoa *num) "> : ")))
                      (*num))))
 
 (while (setq ent (CurveifFoo (lambda (ent)
                                (and (isCurveObject ent)
                                     (vlax-property-available-p
                                       (vlax-ename->vla-object ent) 'Length)))

                    (strcat "\nSelect Curve Number [" (itoa (setq *num (1+ *num))) "] : ")))

   (setq uFlag (not (vla-StartUndoMark doc))
         tStr  (strcat (itoa *num) "- %<\\AcObjProp Object(%<\\_ObjId "
                       (GetObjectID (vlax-ename->vla-object ent)) ">%).Length \\f \"%lu6\>%"))
   (AlignObjtoCurve
     (MCMText spc (getvar 'VIEWCTR) 0. tStr) ent (getvar 'TEXTSIZE))

   (setq uFlag (vla-EndUndoMark doc)))

 (princ))


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


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


(defun isCurveObject (ent)
 (not
   (vl-catch-all-error-p
     (vl-catch-all-apply
       (function vlax-curve-getEndParam) (list ent)))))


(defun CurveifFoo ( foo str / sel ent )
 (while
   (progn
     (setq sel (entsel str))
     
     (cond (  (vl-consp sel)

              (if (not (foo (setq ent (car sel))))
                (princ "\n** Invalid Object Selected **"))))))
 ent)
   

(defun AlignObjToCurve ( obj ent o / *error* msg gr code data pt cAng lAng )
 (vl-load-com)

 (defun *error* (msg)
   (and obj   (not (vlax-erased-p obj)) (vla-delete obj))
   (and uFlag (vla-EndUndoMark doc))
   
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))    
 
 (or *Mac$Per* (setq *Mac$Per* (/ pi 2.)))
 (or *Mac$Off* (setq *Mac$Off* 1.))

 (setq msg  (princ "\n<< [+/-] for offset, [P]erpendicularity toggle >>"))
 
 (while
   (progn
     (setq gr (grread 't 15 0) code (car gr) data (cadr gr))
     
     (cond (  (and (= 5 code) (listp data))
            
              (setq pt   (vlax-curve-getClosestPointto ent data)
                    cAng (angle pt data)
                    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-put-InsertionPoint Obj
                (vlax-3D-point (polar pt cAng (* o *Mac$Off*))))
              (vla-put-Rotation Obj lAng)
            
            t)
           
           (  (= 2 code)
            
              (cond (  (vl-position data '(43 61))
                     
                       (setq *Mac$Off* (+ *Mac$Off* 0.1)))
                    
                    (  (= 45 data)
                     
                       (setq *Mac$Off* (- *Mac$Off* 0.1)))
                    
                    (  (vl-position data '(80 112))
                     
                       (setq *Mac$Per* (- (/ pi 2.) *Mac$Per*)))
                    
                    (  (vl-position data '(13 32))
                     
                       (setq Obj nil))
                    
                    (t )))
           
           (  (and (= 3 code) (listp data))
            
              (setq pt   (vlax-curve-getClosestPointto ent data)
                    cAng (angle pt data)
                    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-put-InsertionPoint Obj
                (vlax-3D-point (polar pt cAng (* o *Mac$Off*))))
              (vla-put-Rotation Obj lAng)
              
              (setq Obj nil))
           
           (  (= 25 code) (setq Obj nil))
           
           (t ))))

 data)

Perhaps look at this also:

http://www.cadtutor.net/forum/showthread.php?t=42426

April 21, 2010

Give this a shot, it uses Fields:

(defun c:PLen ( / *error* doc spc ent uFlag tStr )  
 (vl-load-com)
 ;; Lee Mac  ~  21.04.10

 (defun *error* (msg)
   (and uFlag (vla-EndUndoMark doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))

 (setq doc (vla-get-ActiveDocument
             (vlax-get-acad-object))

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

 (setq *num (cond ( *num ) ( 1 ))
       *num (1- (cond ((getint (strcat "\nSpecify Starting Number <" (itoa *num) "> : ")))
                      (*num))))

 (while (setq ent (CurveifFoo (lambda (ent)
                                (and (isCurveObject ent)
                                     (vlax-property-available-p
                                       (vlax-ename->vla-object ent) 'Length)))

                    (strcat "\nSelect Curve Number [" (itoa (setq *num (1+ *num))) "] : ")))

   (setq uFlag (not (vla-StartUndoMark doc))
         tStr  (strcat (itoa *num) "- %<\\AcObjProp Object(%<\\_ObjId "
                       (GetObjectID (vlax-ename->vla-object ent)) ">%).Length \\f \"%lu6\>%"))
   (AlignObjtoCurve
     (MCMText spc (getvar 'VIEWCTR) 0. tStr) ent (getvar 'TEXTSIZE))

   (setq uFlag (vla-EndUndoMark doc)))

 (princ))


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


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

 o)


(defun isCurveObject (ent)
 (not
   (vl-catch-all-error-p
     (vl-catch-all-apply
       (function vlax-curve-getEndParam) (list ent)))))


(defun CurveifFoo ( foo str / sel ent )
 (while
   (progn
     (setq sel (entsel str))

     (cond (  (vl-consp sel)

              (if (not (foo (setq ent (car sel))))
                (princ "\n** Invalid Object Selected **"))))))
 ent)


(defun AlignObjToCurve ( obj ent o / *error* msg gr code data pt cAng lAng )
 (vl-load-com)

 (defun *error* (msg)
   (and obj   (not (vlax-erased-p obj)) (vla-delete obj))
   (and uFlag (vla-EndUndoMark doc))

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

 (or *Mac$Per* (setq *Mac$Per* (/ pi 2.)))
 (or *Mac$Off* (setq *Mac$Off* 1.))

 (setq msg  (princ "\n<< [+/-] for offset, [P]erpendicularity toggle >>"))

 (while
   (progn
     (setq gr (grread 't 15 0) code (car gr) data (cadr gr))

     (cond (  (and (= 5 code) (listp data))

              (setq pt   (vlax-curve-getClosestPointto ent data)
                    cAng (angle pt data)
                    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-put-InsertionPoint Obj
                (vlax-3D-point (polar pt cAng (* o *Mac$Off*))))
              (vla-put-Rotation Obj lAng)

            t)

           (  (= 2 code)

              (cond (  (vl-position data '(43 61))

                       (setq *Mac$Off* (+ *Mac$Off* 0.1)))

                    (  (= 45 data)

                       (setq *Mac$Off* (- *Mac$Off* 0.1)))

                    (  (vl-position data '(80 112))

                       (setq *Mac$Per* (- (/ pi 2.) *Mac$Per*)))

                    (  (vl-position data '(13 32))

                       (setq Obj nil))

                    (t )))

           (  (and (= 3 code) (listp data))

              (setq pt   (vlax-curve-getClosestPointto ent data)
                    cAng (angle pt data)
                    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-put-InsertionPoint Obj
                (vlax-3D-point (polar pt cAng (* o *Mac$Off*))))
              (vla-put-Rotation Obj lAng)

              (setq Obj nil))

           (  (= 25 code) (setq Obj nil))

           (t ))))

 data)

Lee, is it possible to also pick up the length of an arc ?

(just wondering how to do it ?)

S

April 21, 2010

Give this a shot, it uses Fields:

(defun c:PLen ( / *error* doc spc ent uFlag tStr )  
 (vl-load-com)
 ;; Lee Mac  ~  21.04.10

 (defun *error* (msg)
   (and uFlag (vla-EndUndoMark doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))

 (setq doc (vla-get-ActiveDocument
             (vlax-get-acad-object))

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

 (setq *num (cond ( *num ) ( 1 ))
       *num (1- (cond ((getint (strcat "\nSpecify Starting Number <" (itoa *num) "> : ")))
                      (*num))))

 (while (setq ent (CurveifFoo (lambda (ent)
                                (and (isCurveObject ent)
                                     (vlax-property-available-p
                                       (vlax-ename->vla-object ent) 'Length)))

                    (strcat "\nSelect Curve Number [" (itoa (setq *num (1+ *num))) "] : ")))

   (setq uFlag (not (vla-StartUndoMark doc))
         tStr  (strcat (itoa *num) "- %<\\AcObjProp Object(%<\\_ObjId "
                       (GetObjectID (vlax-ename->vla-object ent)) ">%).Length \\f \"%lu6\>%"))
   (AlignObjtoCurve
     (MCMText spc (getvar 'VIEWCTR) 0. tStr) ent (getvar 'TEXTSIZE))

   (setq uFlag (vla-EndUndoMark doc)))

 (princ))


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


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

 o)


(defun isCurveObject (ent)
 (not
   (vl-catch-all-error-p
     (vl-catch-all-apply
       (function vlax-curve-getEndParam) (list ent)))))


(defun CurveifFoo ( foo str / sel ent )
 (while
   (progn
     (setq sel (entsel str))

     (cond (  (vl-consp sel)

              (if (not (foo (setq ent (car sel))))
                (princ "\n** Invalid Object Selected **"))))))
 ent)


(defun AlignObjToCurve ( obj ent o / *error* msg gr code data pt cAng lAng )
 (vl-load-com)

 (defun *error* (msg)
   (and obj   (not (vlax-erased-p obj)) (vla-delete obj))
   (and uFlag (vla-EndUndoMark doc))

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

 (or *Mac$Per* (setq *Mac$Per* (/ pi 2.)))
 (or *Mac$Off* (setq *Mac$Off* 1.))

 (setq msg  (princ "\n<< [+/-] for offset, [P]erpendicularity toggle >>"))

 (while
   (progn
     (setq gr (grread 't 15 0) code (car gr) data (cadr gr))

     (cond (  (and (= 5 code) (listp data))

              (setq pt   (vlax-curve-getClosestPointto ent data)
                    cAng (angle pt data)
                    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-put-InsertionPoint Obj
                (vlax-3D-point (polar pt cAng (* o *Mac$Off*))))
              (vla-put-Rotation Obj lAng)

            t)

           (  (= 2 code)

              (cond (  (vl-position data '(43 61))

                       (setq *Mac$Off* (+ *Mac$Off* 0.1)))

                    (  (= 45 data)

                       (setq *Mac$Off* (- *Mac$Off* 0.1)))

                    (  (vl-position data '(80 112))

                       (setq *Mac$Per* (- (/ pi 2.) *Mac$Per*)))

                    (  (vl-position data '(13 32))

                       (setq Obj nil))

                    (t )))

           (  (and (= 3 code) (listp data))

              (setq pt   (vlax-curve-getClosestPointto ent data)
                    cAng (angle pt data)
                    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-put-InsertionPoint Obj
                (vlax-3D-point (polar pt cAng (* o *Mac$Off*))))
              (vla-put-Rotation Obj lAng)

              (setq Obj nil))

           (  (= 25 code) (setq Obj nil))

           (t ))))

 data)

Lee, is it possible to also pick up the length of an arc ?

(just wondering how to do it ?)

S

Lee, spoke too soon, (sorry) it works if arc is drawn with pline and not with "arc" command !

cheers

thx for neat program

S

April 21, 2010

It currently uses the Length field - I could modify it to use ArcLength/Circumference - it just needs a few more conditionals.

April 21, 2010

Label each segment with number and distance...

(defun c:PLab (/ obj)
 ;; Label each LWPolyline segment with number and distance
 ;; Alan J. Thompson, 04.21.10
 (if (and (setq obj (car (entsel "\nSelect LWPolyline: ")))
          (or (eq "LWPOLYLINE" (cdr (assoc 0 (entget obj))))
              (alert "Invalid object!")
          )
          (setq obj (vlax-ename->vla-object obj))
     )
   ((lambda (n l / a b)
      (while (nth (1+ (setq n (1+ n))) l)
        (progn
          (vla-put-rotation
            (AT:MText (vlax-3d-point
                        (vlax-curve-GetClosestPointTo
                          obj
                          (mapcar (function (lambda (x y) (/ (+ x y) 2.)))
                                  (setq a (nth n l))
                                  (setq b (nth (1+ n) l))
                          )
                        )
                      )
                      (strcat (itoa (1+ n))
                              " - "
                              (rtos (abs (- (vlax-curve-getDistAtPoint obj a)
                                            (vlax-curve-getDistAtPoint obj b)
                                         )
                                    )
                              )
                      )
                      0.
                      nil
                      8
            )
            (angle a b)
          )
        )
      )
    )
     -1
     (AT:ListGroupByNumber (vlax-get obj 'Coordinates) 2)
   )
 )
 (princ)
)


;;; Add MText to drawing
;;; Pt - MText insertion point
;;; Str - String to place in created MText object
;;; Wd - Width of MText object (if nil, will be 0 width)
;;; Lay - Layer to place Mtext object on (nil for current)
;;; Jus - Justification # for Mtext object
;;;       1 or nil= TopLeft
;;;       2= TopCenter
;;;       3= TopRight
;;;       4= MiddleLeft
;;;       5= MiddleCenter
;;;       6= MiddleRight
;;;       7= BottomLeft
;;;       8= BottomCenter
;;;       9= BottomRight
;;; Alan J. Thompson, 05.23.09 / 04.09.10
(defun AT:MText (Pt Str Wd Lay Jus / Wd s o)
 (or Wd (setq Wd 0.))
 (setq s  (if (or (eq acmodelspace
                      (vla-get-activespace
                        (cond (*AcadDoc*)
                              ((setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
                        )
                      )
                  )
                  (eq :vlax-true (vla-get-mspace *AcadDoc*))
              )
            (vla-get-modelspace *AcadDoc*)
            (vla-get-paperspace *AcadDoc*)
          )
       Pt (cond ((vl-consp Pt) (vlax-3d-point Pt))
                ((eq (type Pt) 'variant) Pt)
          )
 )
 (setq o (vla-addMText s Pt Wd (vl-princ-to-string Str)))
 (and Lay (tblsearch "layer" Lay) (vla-put-layer o Lay))
 (cond ((vl-position Jus '(1 2 3 4 5 6 7 8 9))
        (vla-put-AttachmentPoint o Jus)
        (vla-put-InsertionPoint o Pt)
       )
 )
 o
)



;;; Group items in list based on specified number
;;; L - List to process
;;; # - Number of items for grouping
;;; Alan J. Thompson, 03.26.10
(defun AT:ListGroupByNumber (L # / n g f)
 (setq n -1)
 (while (> (1- (length L)) n)
   (repeat # (setq g (cons (nth (setq n (1+ n)) L) g)))
   (setq f (cons (reverse g) f)
         g nil
   ) ;_ setq
 ) ;_ while
 (reverse f)
) ;_ defun

April 21, 2010

Updated to include Circles and Arcs

(defun c:PLen ( / *error* doc spc ent obj uFlag tStr )  
 (vl-load-com)
 ;; Lee Mac  ~  21.04.10

 (defun *error* (msg)
   (and uFlag (vla-EndUndoMark doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))

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

 (setq *num (cond ( *num ) ( 1 ))
       *num (1- (cond ((getint (strcat "\nSpecify Starting Number <" (itoa *num) "> : ")))
                      (*num))))
 
 (while (setq ent (CurveifFoo (lambda (ent)
                                (and (isCurveObject ent)
                                     (vl-some
                                       (function
                                         (lambda ( property )
                                           (vlax-property-available-p
                                             (vlax-ename->vla-object ent) property)))

                                       '(Length ArcLength Circumference))))

                    (strcat "\nSelect Curve Number [" (itoa (setq *num (1+ *num))) "] : ")))

   (setq uFlag (not (vla-StartUndoMark doc))
         tStr  (strcat (itoa *num) "- %<\\AcObjProp Object(%<\\_ObjId "
                       (GetObjectID (setq obj (vlax-ename->vla-object ent))) ">%)."
                       (vl-some
                         (function
                           (lambda ( property )
                             (if (vlax-property-available-p obj (read property)) property)))

                         '("Length" "ArcLength" "Circumference")) " \\f \"%lu6\>%"))
   (AlignObjtoCurve
     (MCMText spc (getvar 'VIEWCTR) 0. tStr) ent (getvar 'TEXTSIZE))

   (setq uFlag (vla-EndUndoMark doc)))

 (princ))


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


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


(defun isCurveObject (ent)
 (not
   (vl-catch-all-error-p
     (vl-catch-all-apply
       (function vlax-curve-getEndParam) (list ent)))))


(defun CurveifFoo ( foo str / sel ent )
 (while
   (progn
     (setq sel (entsel str))
     
     (cond (  (vl-consp sel)

              (if (not (foo (setq ent (car sel))))
                (princ "\n** Invalid Object Selected **"))))))
 ent)
   

(defun AlignObjToCurve ( obj ent o / *error* msg gr code data pt cAng lAng )
 (vl-load-com)

 (defun *error* (msg)
   (and obj   (not (vlax-erased-p obj)) (vla-delete obj))
   (and uFlag (vla-EndUndoMark doc))
   
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))    
 
 (or *Mac$Per* (setq *Mac$Per* (/ pi 2.)))
 (or *Mac$Off* (setq *Mac$Off* 1.))

 (setq msg  (princ "\n<< [+/-] for offset, [P]erpendicularity toggle >>"))
 
 (while
   (progn
     (setq gr (grread 't 15 0) code (car gr) data (cadr gr))
     
     (cond (  (and (= 5 code) (listp data))
            
              (setq pt   (vlax-curve-getClosestPointto ent data)
                    cAng (angle pt data)
                    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-put-InsertionPoint Obj
                (vlax-3D-point (polar pt cAng (* o *Mac$Off*))))
              (vla-put-Rotation Obj lAng)
            
            t)
           
           (  (= 2 code)
            
              (cond (  (vl-position data '(43 61))
                     
                       (setq *Mac$Off* (+ *Mac$Off* 0.1)))
                    
                    (  (= 45 data)
                     
                       (setq *Mac$Off* (- *Mac$Off* 0.1)))
                    
                    (  (vl-position data '(80 112))
                     
                       (setq *Mac$Per* (- (/ pi 2.) *Mac$Per*)))
                    
                    (  (vl-position data '(13 32))
                     
                       (setq Obj nil))
                    
                    (t )))
           
           (  (and (= 3 code) (listp data))
            
              (setq pt   (vlax-curve-getClosestPointto ent data)
                    cAng (angle pt data)
                    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-put-InsertionPoint Obj
                (vlax-3D-point (polar pt cAng (* o *Mac$Off*))))
              (vla-put-Rotation Obj lAng)
              
              (setq Obj nil))
           
           (  (= 25 code) (setq Obj nil))
           
           (t ))))

 data)

April 22, 2010

I guess I read the request wrong. I was thinking the ability to label each segment length was the desired result. Oh well, it was fun to put together and I might have a use for it (minus the numbering).

Good stuff Lee.

April 22, 2010

Cheers Alan, you too

April 22, 2010

Lee, it's awesome!! That's exactly what I was looking for.

Thanks!

April 22, 2010

You're welcome

I like to use the dynamic approach when placing text, as it gives you a proper preview of what you are about to place. The only drawback to this method is that you don't have any AutoCAD functionality such as OSnap, Ortho, Tracking etc. But I figure most do not use such that regularly to place text.

Lee

April 23, 2010

Alanjt

see attached image and cad file

plab.dwg

April 23, 2010

Alanjt

see attached image and cad file

Ahh, the woes of vlax-curve-getClosestPointTo and not properly considering it's obvious constraints.

Try it now (also removed the need for the AT:MText subroutine since I was defining the ActiveSpace for each text object.

(defun c:PLab (/ obj)
 ;; Label each LWPolyline segment with number and distance
 ;; Alan J. Thompson, 04.21.10 / 04.23.10
 (vl-load-com)
 (if (and (setq obj (car (entsel "\nSelect LWPolyline: ")))
          (or (eq "LWPOLYLINE" (cdr (assoc 0 (entget obj))))
              (alert "Invalid object!")
          )
          (setq obj (vlax-ename->vla-object obj))
     )
   ((lambda (n l s / d)
      (while (nth (1+ (setq n (1+ n))) l)
        ((lambda (a b / dist)
           (setq dist (abs (- (setq d (vlax-curve-getDistAtPoint obj a))
                              (vlax-curve-getDistAtPoint obj b)
                           )
                      )
           )
           ((lambda (p)
              ((lambda (text)
                 (vla-put-AttachmentPoint text 
                 (vla-put-InsertionPoint text p)
                 ;; (vla-put-Rotation text (angle a b))
                 ((lambda (ang)
                    (if (and (> ang (* pi 0.5)) (< ang (* pi 1.5)))
                      (vla-put-rotation text (+ pi ang))
                      (vla-put-rotation text ang)
                    )
                  )
                   (angle a b)
                 )
               )
                (vla-AddMText s p 0. (strcat (itoa (1+ n)) " - " (rtos dist)))
              )
            )
             (vlax-3d-point (vlax-curve-getPointAtDist obj (+ (/ dist 2.) d)))
           )
         )
          (nth n l)
          (nth (1+ n) l)
        )
      )
    )
     -1
     (AT:ListGroupByNumber (vlax-get obj 'Coordinates) 2)
     (if (or (eq acmodelspace
                 (vla-get-activespace
                   (cond (*AcadDoc*)
                         ((setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
                   )
                 )
             )
             (eq :vlax-true (vla-get-mspace *AcadDoc*))
         )
       (vla-get-modelspace *AcadDoc*)
       (vla-get-paperspace *AcadDoc*)
     )
   )
 )
 (princ)
)




;;; Group items in list based on specified number
;;; L - List to process
;;; # - Number of items for grouping
;;; Alan J. Thompson, 03.26.10
(defun AT:ListGroupByNumber (L # / n g f)
 (setq n -1)
 (while (> (1- (length L)) n)
   (repeat # (setq g (cons (nth (setq n (1+ n)) L) g)))
   (setq f (cons (reverse g) f)
         g nil
   ) ;_ setq
 ) ;_ while
 (reverse f)
) ;_ defun

April 24, 2010

I think Alan's gone lambda mad

April 24, 2010

I think Alan's gone lambda mad

ROFL

I did let them get a little out of control. Ever since you did that Boundingbox routine modeled after MP's code, I've been loving and abusing lambda outside of the use of mapcar (or defining as functions like I've been known to do) like a mad man.

I mean, look at this:

    (([color=Red]lambda[/color] (n l s / d)
      (while (nth (1+ (setq n (1+ n))) l)
        (([color=Red]lambda [/color](a b / dist)
           (setq dist (abs (- (setq d (vlax-curve-getDistAtPoint obj a))
                              (vlax-curve-getDistAtPoint obj b)
                           )
                      )
           )
           (([color=Red]lambda [/color](p)
              (([color=Red]lambda [/color](text)
                 (vla-put-AttachmentPoint text 
                 (vla-put-InsertionPoint text p)
                 ;; (vla-put-Rotation text (angle a b))
                 (([color=Red]lambda [/color](ang)

5 lambda expressions

You know, I'm surprised you haven't commented on my abandonment of end line comments and #Variable assigning.

BTW/off topic: I got a 96 on my Trig test (final Monday) and 2 of those points were taken off because I forgot to denote my units on a problem. If you hadn't answered my questions, I would have been completely lost on that section. Thanks a lot.

April 25, 2010

BTW/off topic: I got a 96 on my Trig test (final Monday) and 2 of those points were taken off because I forgot to denote my units on a problem. If you hadn't answered my questions, I would have been completely lost on that section. Thanks a lot.

No worries mate, glad it went well for you

April 29, 2010

Lee Mac the PLen lisp works great for what I am wanting, but would it be possible to have one that would...

Not to do auto numbering.
The total length value gets inserted automatically in the center/midpoint of the polyline.

I would like to go for speed when finding the length of each polyline. If it could be possible I would like to be able to select all polylines and have all the values insert themselvs automatically on each individual polyline.

Thanks agian and hopes its not asking too much.

April 29, 2010

Hi Gordon,

Give this a shot, let me know how you get on (using FIELDS),

[b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] c:PlL [b][color=RED]([/color][/b] [b][color=BLUE]/[/color][/b] *error* spc i ss e Der p obj [b][color=RED])[/color][/b]
 [b][color=RED]([/color][/b][b][color=BLUE]vl-load-com[/color][/b][b][color=RED])[/color][/b]
 [i][color=#990099];; Lee Mac  ~  29.04.10[/color][/i]

 [b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] *error* [b][color=RED]([/color][/b] msg [b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]or[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]wcmatch[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]strcase[/color][/b] msg[b][color=RED])[/color][/b] [b][color=#a52a2a]"*BREAK,*CANCEL*,*EXIT*"[/color][/b][b][color=RED])[/color][/b]
       [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]strcat[/color][/b] [b][color=#a52a2a]"\n** Error: "[/color][/b] msg [b][color=#a52a2a]" **"[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b][b][color=RED])[/color][/b]
 [b][color=RED])[/color][/b]

 [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] spc
   [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b]
     [b][color=RED]([/color][/b][b][color=BLUE]or[/color][/b]
       [b][color=RED]([/color][/b][b][color=BLUE]eq[/color][/b] [color=Blue][b]AcModelSpace[/b][/color]
         [b][color=RED]([/color][/b][b][color=BLUE]vla-get-ActiveSpace[/color][/b]
           [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] doc
             [b][color=RED]([/color][/b][b][color=BLUE]vla-get-ActiveDocument[/color][/b]
               [b][color=RED]([/color][/b][b][color=BLUE]vlax-get-acad-object[/color][/b][b][color=RED])[/color][/b]
             [b][color=RED])[/color][/b]
           [b][color=RED])[/color][/b]
         [b][color=RED])[/color][/b]
       [b][color=RED])[/color][/b]
       [b][color=RED]([/color][/b][b][color=BLUE]eq[/color][/b] [b][color=Blue]:vlax-true[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vla-get-MSpace[/color][/b] doc[b][color=RED])[/color][/b][b][color=RED])[/color][/b]
     [b][color=RED])[/color][/b]
     [b][color=RED]([/color][/b][b][color=BLUE]vla-get-ModelSpace[/color][/b] doc[b][color=RED])[/color][/b]
     [b][color=RED]([/color][/b][b][color=BLUE]vla-get-PaperSpace[/color][/b] doc[b][color=RED])[/color][/b]
   [b][color=RED])[/color][/b]
 [b][color=RED])[/color][/b]

 [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] i [b][color=#009900]-1[/color][/b] ss [b][color=RED]([/color][/b][b][color=BLUE]ssget[/color][/b] [b][color=DARKRED]'[/color][/b][b][color=RED]([/color][/b][b][color=RED]([/color][/b][b][color=#009900]0[/color][/b] . [b][color=#a52a2a]"LINE,*POLYLINE"[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
   
   [b][color=RED]([/color][/b][b][color=BLUE]while[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] e [b][color=RED]([/color][/b][b][color=BLUE]ssname[/color][/b] ss [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] i [b][color=RED]([/color][/b][b][color=BLUE]1+[/color][/b] i[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
     [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] Der
       [b][color=RED]([/color][/b][b][color=BLUE]angle[/color][/b] [b][color=DARKRED]'[/color][/b][b][color=RED]([/color][/b][b][color=#009999]0.[/color][/b] [b][color=#009999]0.[/color][/b] [b][color=#009999]0.[/color][/b][b][color=RED])[/color][/b]
         [b][color=RED]([/color][/b][b][color=BLUE]vlax-curve-getFirstDeriv[/color][/b] e
           [b][color=RED]([/color][/b][b][color=BLUE]vlax-curve-getParamatPoint[/color][/b] e
             [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] p [b][color=RED]([/color][/b]MidPoint e[b][color=RED])[/color][/b][b][color=RED])[/color][/b]
           [b][color=RED])[/color][/b]
         [b][color=RED])[/color][/b]
       [b][color=RED])[/color][/b]
     [b][color=RED])[/color][/b]
               
     [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] Obj
       [b][color=RED]([/color][/b]MCMText spc [b][color=RED]([/color][/b][b][color=BLUE]polar[/color][/b] p [b][color=RED]([/color][/b][b][color=BLUE]-[/color][/b] Der [b][color=RED]([/color][/b][b][color=BLUE]/[/color][/b] [b][color=BLUE]pi[/color][/b] [b][color=#009999]2.[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]getvar[/color][/b] [b][color=DARKRED]'[/color][/b]TEXTSIZE[b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=#009999]0.[/color][/b]
         [b][color=RED]([/color][/b][b][color=BLUE]strcat[/color][/b] [b][color=#a52a2a]"%<\\AcObjProp Object(%<\\_ObjId "[/color][/b]
           [b][color=RED]([/color][/b]GetObjectID [b][color=RED]([/color][/b][b][color=BLUE]vlax-ename->vla-object[/color][/b] e[b][color=RED])[/color][/b] doc[b][color=RED])[/color][/b] [b][color=#a52a2a]">%).Length \\f \"[/color][color=#a52a2a]%lu6\[/color][/b][b][color=#a52a2a]">%"[/color][/b]
         [b][color=RED])[/color][/b]
       [b][color=RED])[/color][/b]
     [b][color=RED])[/color][/b]

     [b][color=RED]([/color][/b][b][color=BLUE]vla-put-rotation[/color][/b] Obj [b][color=RED]([/color][/b]MakeReadable Der[b][color=RED])[/color][/b][b][color=RED])[/color][/b]
   [b][color=RED])[/color][/b]
 [b][color=RED])[/color][/b]
 [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b][b][color=RED])[/color][/b]
[b][color=RED])[/color][/b]

[b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] MCMText [b][color=RED]([/color][/b]block point width string [b][color=BLUE]/[/color][/b] o[b][color=RED])[/color][/b]
 [b][color=RED]([/color][/b][b][color=BLUE]vla-put-AttachmentPoint[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] o [b][color=RED]([/color][/b][b][color=BLUE]vla-AddMText[/color][/b] block
             [b][color=RED]([/color][/b][b][color=BLUE]vlax-3D-point[/color][/b] point[b][color=RED])[/color][/b] width string[b][color=RED])[/color][/b][b][color=RED])[/color][/b]
   [b][color=Blue]acAttachmentPointMiddleCenter[/color][color=RED])[/color][/b]
 
 [b][color=RED]([/color][/b][b][color=BLUE]vla-put-InsertionPoint[/color][/b] o [b][color=RED]([/color][/b][b][color=BLUE]vlax-3D-point[/color][/b] point[b][color=RED])[/color][/b][b][color=RED])[/color][/b]
 
 o[b][color=RED])[/color][/b]

[b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] MakeReadable [b][color=RED]([/color][/b] a [b][color=RED])[/color][/b]
 [b][color=RED]([/color][/b][b][color=BLUE]cond[/color][/b]
   [b][color=RED]([/color][/b]
     [b][color=RED]([/color][/b][b][color=BLUE]and[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]>[/color][/b] a [b][color=RED]([/color][/b][b][color=BLUE]/[/color][/b] [b][color=BLUE]pi[/color][/b] [b][color=#009900]2[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]<=[/color][/b] a [b][color=BLUE]pi[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]

     [b][color=RED]([/color][/b][b][color=BLUE]-[/color][/b] a [b][color=BLUE]pi[/color][/b][b][color=RED])[/color][/b]
   [b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b]
     [b][color=RED]([/color][/b][b][color=BLUE]and[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]>[/color][/b] a [b][color=BLUE]pi[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]<=[/color][/b] a [b][color=RED]([/color][/b][b][color=BLUE]/[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]*[/color][/b] [b][color=#009900]3[/color][/b] [b][color=BLUE]pi[/color][/b][b][color=RED])[/color][/b] [b][color=#009900]2[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]

     [b][color=RED]([/color][/b][b][color=BLUE]+[/color][/b] a [b][color=BLUE]pi[/color][/b][b][color=RED])[/color][/b]
   [b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b]
     a
   [b][color=RED])[/color][/b]
 [b][color=RED])[/color][/b]
[b][color=RED])[/color][/b]

[b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] GetObjectID [b][color=RED]([/color][/b] obj doc [b][color=RED])[/color][/b]
 [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]eq[/color][/b] [b][color=#a52a2a]"X64"[/color][/b]
     [b][color=RED]([/color][/b][b][color=BLUE]strcase[/color][/b]
       [b][color=RED]([/color][/b][b][color=BLUE]getenv[/color][/b] [b][color=#a52a2a]"PROCESSOR_ARCHITECTURE"[/color][/b][b][color=RED])[/color][/b]
     [b][color=RED])[/color][/b]
   [b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]vlax-invoke-method[/color][/b]
     [b][color=RED]([/color][/b][b][color=BLUE]vla-get-Utility[/color][/b] doc[b][color=RED])[/color][/b] [b][color=DARKRED]'[/color][/b]GetObjectIdString obj [b][color=Blue]:vlax-false[/color][/b]
   [b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]itoa[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vla-get-Objectid[/color][/b] obj[b][color=RED])[/color][/b][b][color=RED])[/color][/b]
 [b][color=RED])[/color][/b]
[b][color=RED])[/color][/b]

[b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] MidPoint [b][color=RED]([/color][/b] e [b][color=RED])[/color][/b]
 [b][color=RED]([/color][/b][b][color=BLUE]vlax-curve-getPointatDist[/color][/b] e
   [b][color=RED]([/color][/b][b][color=BLUE]/[/color][/b]
     [b][color=RED]([/color][/b][b][color=BLUE]-[/color][/b]
       [b][color=RED]([/color][/b][b][color=BLUE]vlax-curve-getDistatPoint[/color][/b] e
         [b][color=RED]([/color][/b][b][color=BLUE]vlax-curve-getEndPoint[/color][/b] e[b][color=RED])[/color][/b]
       [b][color=RED])[/color][/b]
       [b][color=RED]([/color][/b][b][color=BLUE]vlax-curve-getDistatPoint[/color][/b] e
         [b][color=RED]([/color][/b][b][color=BLUE]vlax-curve-getStartPoint[/color][/b] e[b][color=RED])[/color][/b]
       [b][color=RED])[/color][/b]
     [b][color=RED])[/color][/b]
     [b][color=#009999]2.[/color][/b]
   [b][color=RED])[/color][/b]
 [b][color=RED])[/color][/b]
[b][color=RED])[/color][/b]

autonumbering and lenght

Recommended Posts

woohhoo

Link to comment

Share on other sites

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Posted Images

Lee Mac

Link to comment

Share on other sites

woohhoo

Link to comment

Share on other sites

Lee Mac

Link to comment

Share on other sites

stevesfr

Link to comment

Share on other sites

stevesfr

Link to comment

Share on other sites

Lee Mac

Link to comment

Share on other sites

alanjt

Link to comment

Share on other sites

Lee Mac

Link to comment

Share on other sites

alanjt

Link to comment

Share on other sites

Lee Mac

Link to comment

Share on other sites

woohhoo

Link to comment

Share on other sites

Lee Mac

Link to comment

Share on other sites

asos2000

Link to comment

Share on other sites

alanjt

Link to comment

Share on other sites

Lee Mac

Link to comment

Share on other sites

alanjt

Link to comment

Share on other sites

Lee Mac

Link to comment

Share on other sites

gordon_Gjs

Link to comment

Share on other sites

Lee Mac

Link to comment

Share on other sites

Join the conversation

Tutorials

Forums

Activity