drawing line according to polyline length

[justas]

hello,

 

is there a way to draw lines connected to each other in one straight line. which would be drawn from the lengths of segments between intersection of polyline ?

i attached the situation.jpg to clear up the ... "situation"..

until now i was trying to use intlen.lsp to automatically show the lenghts of segments and then i would just dra lines one after each other with relative coordinates from the numbers i got from intlen.lsp...

thanks in advance..

IntLenV1-4.lsp

[Lee Mac]

Welcome to CADTutor - I'm pleased to see that you find my Length Between Intersections program useful!

 

Try the following quickly-written code:

(defun c:ll ( / dir ent par pnt )
   (while
       (progn (setvar 'errno 0) (setq ent (car (entsel)))
           (cond
               (   (= 7 (getvar 'errno))
                   (princ "\nMissed, try again.")
               )
               (   (null ent) nil)
               (   (vl-catch-all-error-p (setq par (vl-catch-all-apply 'vlax-curve-getendparam (list ent))))
                   (princ "\nInvalid object selected.")
               )
           )
       )
   )
   (if
       (and par
           (setq pnt (getpoint "\nSpecify base point: "))
           (setq dir (getpoint pnt "\nSpecify line direction: "))
       )
       (entmake
           (list
              '(0 . "LINE")
               (cons 10 (trans pnt 1 0))
               (cons 11 (trans (polar pnt (angle pnt dir) (vlax-curve-getdistatparam ent par)) 1 0))
           )
       )
   )
   (princ)
)
(vl-load-com) (princ)

[justas]

thank you for the reply..

and yes your length between intersections command is very usefull for the project i am working right now..

i managed to try your new command..

maybe i was not very clear of what i need.. its not exactly what i was looking for, but very close..

i need not the line which is the length of polyline but the lengths between intersections, only straightened to one line..

i attached another example.. but this time from the real project..

i have some parts.. which in this drawing are blue and the green polyline which intersects the blue parts in certain points marked in red..

with your length between intersections command i was able to see all the lengths (yellow) at once.. so i could just draw the lines one by one after each other by writing the lengths.. and the white line in the bottom part of the drawing is what i need.. but because i have about 300 different polylines like this and still have to have the ability to correct them later.. its too much time consuming..

so i thought its possible to make it automatically.. ..

i hope its clear.. thank you for your help..

[BIGAL]

As an alternative maybe easier for plines just get co-ords work out length as a new list then just start pt and angle draw lengths, Lee ran your code not sure what I was to actually get ?

 

not tested cut from other programs but method is sound if I can find a few minutes will do rest.

(defun getcoords (ent)
 (vlax-safearray->list
   (vlax-variant-value
     (vlax-get-property
   (vlax-ename->vla-object ent)
   "Coordinates"
     )
   )
 )
)

(defun co-ords2xy ()
; convert now to a list of xy as co-ords are x y x y x y if 3d x y z x y z
(setq numb (/ (length co-ords) 2))
(setq I 0)
(repeat numb
(setq xy (list (nth (+ I 1) co-ords)(nth I co-ords) ))
(setq coordsxy (cons xy coordsxy))
(setq I (+ I 2))
) ; end repeat
)

(setq obj  (car (entsel "Pick Pline")))
(setq co-ords (getcoords obj))

(co-ords2xy)
(princ coordsxy)

; now use list to work out lengths and draw line

[justas]

thanks for the reply..

but as i see i find it hard to explain what i need..

maybe i should attach the dwg file?

i dont know how to write the code but the way i see it..

it should be possible to combine LeeMacs code for the length between intersections and the code he wrote in this thread..

 

another try for the explanation:

lets say i have an arc which is 15 in length.

it has an intersection with another object at point which divides the arc into two elements. 5 and 10 in lengths..

so the outcome of this situation should be the straight line of length 15 divided into two parts 5 and 10..

it can be one line with a node at the right coordinates,

or two lines drawn one after another with a lengths of 5 and 10..

i just need to be able to snap at that point on straight line..

[BIGAL]

Justas dont use dark blue in image starting to understand now and yes Lee is on track as usual. Take pline draw its total length then segment it, each crossing line. I will leave it for Lee he is too good at this stuff.

[justas]

thanks for the help...

i can see now that the blue line was a really bad choice.. and the quality is not good either.. but dont know how to make it better.. it was just a screenshot, but somehow it went to a very poor quality when attached...

[Lee Mac]

Try the following code:

(defun c:intl ( / ang app bpt ent idx llp lst obj ocs par pts sel urp )
   (while
       (progn
           (setvar 'errno 0)
           (setq ent (car (entsel)))
           (cond
               (   (= 7 (getvar 'errno))
                   (princ "\nMissed, try again.")
               )
               (   (null ent)
                   nil
               )
               (   (vl-catch-all-error-p (setq par (vl-catch-all-apply 'vlax-curve-getendparam (list ent))))
                   (princ "\nInvalid object selected.")
               )
           )
       )
   )
   (if
       (and
           (= 'ename (type ent))
           (setq bpt (getpoint "\nSpecify base point: "))
           (setq ang (getangle "\nSpecify line direction: " bpt))
       )
       (progn
           (setq ocs (trans '(0.0 0.0 1.0) 1 0 t)
                 app (vlax-get-acad-object)
                 obj (vlax-ename->vla-object ent)
                 lst (append
                         (vlax-curve-getpointatparam ent (vlax-curve-getstartparam ent))
                         (vlax-curve-getpointatparam ent (vlax-curve-getendparam   ent))
                     )
           )
           (vla-getboundingbox obj 'llp 'urp)
           (vla-zoomwindow app llp urp)
           (if
               (setq sel
                   (ssget "_C"
                       (trans (vlax-safearray->list urp) 0 1)
                       (trans (vlax-safearray->list llp) 0 1)
                      '((0 . "ARC,CIRCLE,ELLIPSE,*LINE"))
                   )
               )
               (progn
                   (ssdel ent sel)
                   (repeat (setq idx (sslength sel))
                       (setq lst
                           (append lst
                               (vlax-invoke obj 'intersectwith
                                   (vlax-ename->vla-object (ssname sel (setq idx (1- idx))))
                                   acextendnone
                               )
                           )
                       )
                   )
               )
           )
           (vla-zoomprevious app)
           (repeat (/ (length lst) 3)
               (setq pts (cons (trans (list (car lst) (cadr lst) (caddr lst)) 0 ocs) pts)
                     lst (cdddr lst)
               )
           )
           (setq lst
               (mapcar
                   (function
                       (lambda ( x )
                           (cons 10 (trans (polar bpt ang x) 1 ocs))
                       )
                   )
                   (vl-sort
                       (mapcar
                           (function
                               (lambda ( x )
                                   (vlax-curve-getdistatpoint ent
                                       (vlax-curve-getclosestpointto ent x)
                                   )
                               )
                           )
                           (LM:uniquefuzz pts 1e-8)
                       )
                       '<
                   )
               )
           )
           (entmake
               (append
                   (list
                      '(000 . "LWPOLYLINE")
                      '(100 . "AcDbEntity")
                      '(100 . "AcDbPolyline")
                       (cons 90 (length lst))
                      '(070 . 0)
                   )
                   lst
                   (list (cons 210 ocs))
               )
           )
       )
   )
   (princ)
)

;; Unique with Fuzz  -  Lee Mac
;; Returns a list with all elements considered duplicate to a given tolerance removed.

(defun LM:UniqueFuzz ( l f / x r )
   (while l
       (setq x (car l)
             l (vl-remove-if (function (lambda ( y ) (equal x y f))) (cdr l))
             r (cons x r)
       )
   )
   (reverse r)
)
(vl-load-com) (princ)

 

Edited June 6, 2022 by Lee Mac

[justas]

thank you..

it works perfectly...

[Noblelenient]

That was an excellent solution, you guys are the best!!! however I was looking for a little bit extra, I mean "rolling out" a polyline, a lsp that takes a polyline like this (of course the one in the pic ain't a polyline, but colored lines for clarifying purposes): and outputs "Linear" horizontal straight lines like this: , where each line is EXACTLY the same length as its same color segment in the poly, there have been so many trials, best one I could find is this one by "motee-z" and "pBe" here: http://www.cadtutor.net/forum/showthread.php?54598-project-chainage-of-polyline-on-a-straight-line/page3, and to be honest, they did a great job, although the final solution (so far) doesn't support curves, unlike the one here, can you guys help me on this? and thanks in advance, keep this great work going!

Edited March 19, 2015 by Noblelenient
images

[Noblelenient]

On 5/31/2014 at 8:35 PM, Lee Mac said:

Try the following code:

 

(defun c:intl ( / ang app bpt ent idx llp lst obj ocs par pts sel urp )
   (while
       (progn
           (setvar 'errno 0)
           (setq ent (car (entsel)))
           (cond
               (   (= 7 (getvar 'errno))
                   (princ "\nMissed, try again.")
               )
               (   (null ent)
                   nil
               )
               (   (vl-catch-all-error-p (setq par (vl-catch-all-apply 'vlax-curve-getendparam (list ent))))
                   (princ "\nInvalid object selected.")
               )
           )
       )
   )
   (if
       (and
           (= 'ename (type ent))
           (setq bpt (getpoint "\nSpecify base point: "))
           (setq ang (getangle "\nSpecify line direction: " bpt))
       )
       (progn
           (setq ocs (trans '(0.0 0.0 1.0) 1 0 t)
                 app (vlax-get-acad-object)
                 obj (vlax-ename->vla-object ent)
                 lst (append
                         (vlax-curve-getpointatparam ent (vlax-curve-getstartparam ent))
                         (vlax-curve-getpointatparam ent (vlax-curve-getendparam   ent))
                     )
           )
           (vla-getboundingbox obj 'llp 'urp)
           (vla-zoomwindow app llp urp)
           (if
               (setq sel
                   (ssget "_C"
                       (trans (vlax-safearray->list urp) 0 1)
                       (trans (vlax-safearray->list llp) 0 1)
                      '((0 . "ARC,CIRCLE,ELLIPSE,*LINE"))
                   )
               )
               (progn
                   (ssdel ent sel)
                   (repeat (setq idx (sslength sel))
                       (setq lst
                           (append lst
                               (vlax-invoke obj 'intersectwith
                                   (vlax-ename->vla-object (ssname sel (setq idx (1- idx))))
                                   acextendnone
                               )
                           )
                       )
                   )
               )
           )
           (vla-zoomprevious app)
           (repeat (/ (length lst) 3)
               (setq pts (cons (trans (list (car lst) (cadr lst) (caddr lst)) 0 ocs) pts)
                     lst (cdddr lst)
               )
           )
           (setq lst
               (mapcar
                   (function
                       (lambda ( x )
                           (cons 10 (trans (polar bpt ang x) 1 ocs))
                       )
                   )
                   (vl-sort
                       (mapcar
                           (function
                               (lambda ( x )
                                   (vlax-curve-getdistatpoint ent
                                       (vlax-curve-getclosestpointto ent x)
                                   )
                               )
                           )
                           (LM:uniquefuzz pts 1e-
                       )
                       '<
                   )
               )
           )
           (entmake
               (append
                   (list
                      '(000 . "LWPOLYLINE")
                      '(100 . "AcDbEntity")
                      '(100 . "AcDbPolyline")
                       (cons 90 (length lst))
                      '(070 . 0)
                   )
                   lst
                   (list (cons 210 ocs))
               )
           )
       )
   )
   (princ)
)

;; Unique with Fuzz  -  Lee Mac
;; Returns a list with all elements considered duplicate to a given tolerance removed.

(defun LM:UniqueFuzz ( l f / x r )
   (while l
       (setq x (car l)
             l (vl-remove-if (function (lambda ( y ) (equal x y f))) (cdr l))
             r (cons x r)
       )
   )
   (reverse r)
)    
(vl-load-com) (princ)

 

 

 something wrong with this code?

[Lee Mac]

5 minutes ago, Noblelenient said:

 something wrong with this code?

The upgrade to the forum software a couple of years ago unfortunately caused all instances of "8)" to be removed from code snippets, breaking thousands of examples - I've now edited my earlier post and have corrected the above code.

[Lee Mac]

On 3/19/2015 at 1:44 AM, Noblelenient said:

That was an excellent solution, you guys are the best!!! however I was looking for a little bit extra, I mean "rolling out" a polyline, a lsp that takes a polyline like this (of course the one in the pic ain't a polyline, but colored lines for clarifying purposes):

http://i.imgur.com/cQE61QP.png

 

And outputs "Linear" horizontal straight lines like this: http://i.imgur.com/11JPupc.png

 

Where each line is EXACTLY the same length as its same color segment in the poly, there have been so many trials, best one I could find is this one by "motee-z" and "pBe" here: http://www.cadtutor.net/forum/showthread.php?54598-project-chainage-of-polyline-on-a-straight-line/page3, and to be honest, they did a great job, although the final solution (so far) doesn't support curves, unlike the one here, can you guys help me on this? and thanks in advance, keep this great work going!

 

Hopefully not 7 years too late...

(defun c:unfold ( / ang bpt ent lst ocs par )
    (while
        (progn
            (setvar 'errno 0)
            (setq ent (car (entsel)))
            (cond
                (   (= 7 (getvar 'errno))
                    (princ "\nMissed, try again.")
                )
                (   (null ent)
                    nil
                )
                (   (or (vl-catch-all-error-p (setq par (vl-catch-all-apply 'vlax-curve-getendparam (list ent)))) (null par))
                    (princ "\nInvalid object selected.")
                )
            )
        )
    )
    (if
        (and
            (= 'ename (type ent))
            (setq bpt (getpoint "\nSpecify base point: "))
            (setq ang (getangle "\nSpecify line direction: " bpt))
        )
        (progn
            (setq ocs (trans '(0 0 1) 1 0 t))
            (if (wcmatch (cdr (assoc 0 (entget ent))) "*POLYLINE")
                (repeat (setq par (fix (+ 1e-8 par)))
                    (setq lst (cons (cons 010 (trans (polar bpt ang (vlax-curve-getdistatparam ent par)) 1 ocs)) lst)
                          par (1- par)
                    )
                )
                (setq lst (list (cons 010 (trans (polar bpt ang (vlax-curve-getdistatparam ent (vlax-curve-getendparam ent))) 1 ocs))))
            )
            (entmake
               (append
                   (list
                      '(000 . "LWPOLYLINE")
                      '(100 . "AcDbEntity")
                      '(100 . "AcDbPolyline")
                       (cons 090 (1+ (length lst)))
                      '(070 . 0)
                   )
                   (cons (cons 010 (trans bpt 1 ocs)) lst)
                   (list (cons 210 ocs))
               )
           )
        )
    )
    (princ)
)

 

The above should work with any curve object of finite length.

[Noblelenient]

3 hours ago, Lee Mac said:

Hopefully not 7 years too late...

YOU ARE THE BOSS, LEE!!! I LIKE YOU!

[Lee Mac]

Thank you