Distances on a Polyline

[Jozi68]

Hi All,

I am working in 2D, AutoCad 2009. I have a polyline that is made up of lines and arcs. I need a Visual Basic routine that starts at one end of the polyline, finds all lines perpendicular to itself, and then inserts text on the perpendicular line that contains the distance from the start of the polyline to the intersection.

I know some VB, but am new to Autocad. Any help will be much appreciated.

regards,

Jozi

[SEANT]

Which particular flavor of VB are you using?

 

If it is one of the VB6 based (i.e., Visual Studio 6, VBA) then you will likely find the task rather annoying. Vanilla AutoCAD does not directly expose a VB compatible API for Polyline analysis. You will have to either write you own Poly measuring routine (though some examples are already available online) or use a vlax-curve hook (see this thread for more info: http://www.cadtutor.net/forum/showthread.php?t=19379)

 

If you are using VB.NET the options are more direct as the managed API exposes more functionality in that regard.

[Jozi68]

I am using VB6, is this very bad?

[SEANT]

Actually, it is. I would advise against writing any new VB6 based code.

 

Microsoft has long since stopped development along that architecture (concentrating on .NET instead) and Autodesk, though offering some VB6 transition measures, also advises programming in (and porting existing VB6/VBA based code to) .NET.

 

As tiresome as it may seem to learn the newer variant of the language, VB.NET makes many tasks easier with the broader API.

[Lee Mac]

Give this a shot:

 

(defun c:IntTxt  (/ cEnt cObj ss ObjLst iLst ptLst PLst lAng)
 (vl-load-com)
 (if (and (setq cEnt (car (entsel "\nSelect Curve: ")))
          (member (cdr (assoc 0 (entget cEnt)))
                  '("LINE" "POLYLINE" "LWPOLYLINE" "SPLINE" "ARC")))
   (progn
     (setq cObj   (vlax-ename->vla-object cEnt)
           ss     (ssget "X" (list (cons 0 "LINE,*POLYLINE")
                                   (if (getvar "CTAB")
                                     (cons 410 (getvar "CTAB"))
                                     (cons 67 (- 1 (getvar "TILEMODE"))))))
           ObjLst (vl-remove-if-not
                    (function
                      (lambda (x)
                        (> (vlax-safearray-get-u-bound
                             (vlax-variant-value
                               (vla-IntersectWith x cObj acExtendNone)) 1) 0)))
                    (mapcar 'vlax-ename->vla-object
                      (vl-remove-if
                        (function
                          (lambda (x) (eq x cEnt)))
                            (mapcar 'cadr (ssnamex ss))))))
     (foreach Obj  ObjLst
       (setq iLst (vlax-safearray->list
                    (vlax-variant-value
                      (vla-IntersectWith Obj cObj acExtendNone))))
       (while (not (zerop (length iLst)))
         (setq ptLst (cons (list (car iLst) (cadr iLst) (caddr iLst)) ptLst)
               iLst  (cdddr iLst)))
       (setq PLst  (cons (cons Obj ptLst) PLst) ptLst nil iLst  nil))
     (setq PLst
            (vl-remove-if-not
              (function
                (lambda (x)
                  (equal (/ pi 2)
                         (abs (- (angle '(0 0 0)
                                        (vlax-curve-getFirstDeriv (car x)
                                          (vlax-curve-getParamatPoint (car x) (cadr x))))
                                 (angle '(0 0 0)
                                        (vlax-curve-getFirstDeriv cObj
                                          (vlax-curve-getParamatPoint cObj (cadr x)))))) 0.01))) PLst))
     (foreach Obj  PLst
       (setq lAng (angle '(0 0 0) (vlax-curve-getFirstDeriv (car Obj)
                    (vlax-curve-getParamatPoint (car Obj) (cadr Obj)))))
       (cond ((and (> lAng (/ pi 2)) (<= lAng pi))
              (setq lAng (- lAng pi)))
             ((and (> lAng pi) (<= lAng (/ (* 3 pi) 2)))
              (setq lAng (+ lAng pi))))
       (Make_Text (cadr Obj) (rtos (vlax-curve-getDistatPoint cObj (cadr Obj)) 2 2) lAng)))
   (princ "\n<!> No Curve Selected <!>"))
 (princ))


(defun Make_Text  (pt val rot)
 (entmake (list '(0 . "TEXT")
                '(8 . "TEXT")
                (cons 62 2)
                (cons 10 pt)
                (cons 40 (getvar "TEXTSIZE"))
                (cons 1 val)
                (cons 50 rot)
                (cons 7 (getvar "TEXTSTYLE"))
                '(71 . 0)
                '(72 . 0)
                '(73 . 1)
                (cons 11 pt))))

[Jozi68]

Thanks for the code Lee Mac. Could you please explain to me step by step what I should do with it? I have no idea what to do. Is this LISP?

[Lee Mac]

This is indeed LISP. (with elements of Visual LISP).

 

Instructions for running:

 

• Copy ALL the text within the code frame in my above post.

• Paste this text into a new Notepad document

• Save this file as filename.lsp (the filename can be whatever you like).

• Go to AutoCAD.

• type "appload" at the command line.

• Locate where you just save the .lsp file.

• Click Load to load the file, and close the appload dialog box.

• Type "inttxt" at the command line to invoke function.

Hope this helps!

 

Lee

[Lee Mac]

More info here:

 

 

http://www.cadtutor.net/faq/questions/28/How+do+I+use+an+AutoLISP+routine%3F

[Lee Mac]

Did my LISP help you Jozi68?

[Jozi68]

Hi Lee Mac,

Please forgive me for disappearing like that. I had a bit of a crisis on this side. I am now back on the job, facing the same problem. Thanx for the LISP you sent me. I will need something in VB code though, as I will need to make changes to it. The LISP is greek to me.

[Lee Mac]

Hi Lee Mac,

Please forgive me for disappearing like that. I had a bit of a crisis on this side. I am now back on the job, facing the same problem. Thanx for the LISP you sent me. I will need something in VB code though, as I will need to make changes to it. The LISP is greek to me.

 

Thank you for your response Jozi, I'm glad that things are all sorted your end.

[stevesfr]

Give this a shot:

 

(defun c:IntTxt  (/ cEnt cObj ss ObjLst iLst ptLst PLst lAng)
 (vl-load-com)
 (if (and (setq cEnt (car (entsel "\nSelect Curve: ")))
          (member (cdr (assoc 0 (entget cEnt)))
                  '("LINE" "POLYLINE" "LWPOLYLINE" "SPLINE" "ARC")))
   (progn
     (setq cObj   (vlax-ename->vla-object cEnt)
           ss     (ssget "X" (list (cons 0 "LINE,*POLYLINE")
                                   (if (getvar "CTAB")
                                     (cons 410 (getvar "CTAB"))
                                     (cons 67 (- 1 (getvar "TILEMODE"))))))
           ObjLst (vl-remove-if-not
                    (function
                      (lambda (x)
                        (> (vlax-safearray-get-u-bound
                             (vlax-variant-value
                               (vla-IntersectWith x cObj acExtendNone)) 1) 0)))
                    (mapcar 'vlax-ename->vla-object
                      (vl-remove-if
                        (function
                          (lambda (x) (eq x cEnt)))
                            (mapcar 'cadr (ssnamex ss))))))
     (foreach Obj  ObjLst
       (setq iLst (vlax-safearray->list
                    (vlax-variant-value
                      (vla-IntersectWith Obj cObj acExtendNone))))
       (while (not (zerop (length iLst)))
         (setq ptLst (cons (list (car iLst) (cadr iLst) (caddr iLst)) ptLst)
               iLst  (cdddr iLst)))
       (setq PLst  (cons (cons Obj ptLst) PLst) ptLst nil iLst  nil))
     (setq PLst
            (vl-remove-if-not
              (function
                (lambda (x)
                  (equal (/ pi 2)
                         (abs (- (angle '(0 0 0)
                                        (vlax-curve-getFirstDeriv (car x)
                                          (vlax-curve-getParamatPoint (car x) (cadr x))))
                                 (angle '(0 0 0)
                                        (vlax-curve-getFirstDeriv cObj
                                          (vlax-curve-getParamatPoint cObj (cadr x)))))) 0.01))) PLst))
     (foreach Obj  PLst
       (setq lAng (angle '(0 0 0) (vlax-curve-getFirstDeriv (car Obj)
                    (vlax-curve-getParamatPoint (car Obj) (cadr Obj)))))
       (cond ((and (> lAng (/ pi 2)) (<= lAng pi))
              (setq lAng (- lAng pi)))
             ((and (> lAng pi) (<= lAng (/ (* 3 pi) 2)))
              (setq lAng (+ lAng pi))))
       (Make_Text (cadr Obj) (rtos (vlax-curve-getDistatPoint cObj (cadr Obj)) 2 2) lAng)))
   (princ "\n<!> No Curve Selected <!>"))
 (princ))


(defun Make_Text  (pt val rot)
 (entmake (list '(0 . "TEXT")
                '(8 . "TEXT")
                (cons 62 2)
                (cons 10 pt)
                (cons 40 (getvar "TEXTSIZE"))
                (cons 1 val)
                (cons 50 rot)
                (cons 7 (getvar "TEXTSTYLE"))
                '(71 . 0)
                '(72 . 0)
                '(73 . 1)
                (cons 11 pt))))

 

Any reason why only lines drawn perpendicular on one side of the pline are identified with a distance?

Steveo

[Lee Mac]

Any reason why only lines drawn perpendicular on one side of the pline are identified with a distance?

Steveo

 

works for me... although it is a bit temperamental...

[Jozi68]

Anybody?

I just need to traverse a polyline, find perpendicular lines, and then the distance from the start to the points where the lines start (also coordinates of the points). It has to be VB code unfortunately, so I can work with it.

[fuqua]

i need a similar routine, when i select a certain object the routine must auto lookup all the poly lines attached to it and report me the total lenght of all the polylines.

 

but it needs to do this within the cluster borders, does anyone know what i mean and can help me out ?

 

much appreciated

[Lee Mac]

i need a similar routine, when i select a certain object the routine must auto lookup all the poly lines attached to it and report me the total lenght of all the polylines.

 

but it needs to do this within the cluster borders, does anyone know what i mean and can help me out ?

 

much appreciated

 

I think I understand - are you saying all the polylines, irrelevant of their angle to the original polyline?

 

Also, what do you mean by Cluster Borders?

[fuqua]

I think I understand - are you saying all the polylines, irrelevant of their angle to the original polyline?

 

Also, what do you mean by Cluster Borders?

 

yes all polylines irrelevant of their angle to the main pline, within the cluster (and yes a cluster is a line functioning as a absolute border)

 

so when the tool is calculating a polyline that goes from cluster to cluster it should only calculate the polyline till the border of the cluster.... how bout that for a challenge.

 

to even go a step further, i have a single object, to which the main polyline is connected, i want to click on that object and from there on a program in the background should calculate the length of the main polyline and all other polylines connected to it but respecting the cluster border as an "end of the line" no crossing over

[Lee Mac]

yes all polylines irrelevant of their angle to the main pline, within the cluster (and yes a cluster is a line functioning as a absolute border)

 

so when the tool is calculating a polyline that goes from cluster to cluster it should only calculate the polyline till the border of the cluster.... how bout that for a challenge.

 

to even go a step further, i have a single object, to which the main polyline is connected, i want to click on that object and from there on a program in the background should calculate the length of the main polyline and all other polylines connected to it but respecting the cluster border as an "end of the line" no crossing over

 

This will be difficult considering that the line can cross over a border. I can create a program to get the lengths of all the polylines intersecting a single polyline, but filtering those that cross after the border would be very hard.

[fuqua]

there is always only 1 line that crosses the border which is also in a seperate layer, also to work around the problem we could cut the crossing line at the border. does this help ?

[Lee Mac]

there is always only 1 line that crosses the border which is also in a seperate layer, also to work around the problem we could cut the crossing line at the border. does this help ?

 

I'll see what I can come up with.