Topic: Polyline drawn with multiple vertices from two pick points?

[demesne]

Hi

I've been told I may be able to find what I'm looking for over here.

Does anyone have a routine (I've searched but can't find) to draw a straight polyline with a vertex every metre (or other specified distance). Also useful would be the option to 'equal segment lengths'.

So, if a polyline was drawn by picking two points, start and end, and the line had a length of, say, 7.2m then there would be the option to add a vertex every metre, leaving the last segment length at 0.2m, or, each segment length would be the same - 7 segments at 1.028571428571429m (I didn't work that out in my head!).

I see that if the user picks more than two initial points then the routine would have to treat each initial segment individually. Would also be useful if it worked with arcs.

Like I said, I have looked but couldn't find anything.

Oh, btw, I'm fitting polylines to point cloud data using 3rd party software.

Regards
Demesne

[CAB]

Welcome to the Swamp.

There are many lisp that almost do what you want but not exactly.
Most deal with an existing pline and would need to be modified.

[demesne]

Thanks.  I don't suppose you know where I'd find them do you.  I have searched, but to no avail.

[CAB]

I'll look when I get back but here is a quickie, no testing.

Code - Auto/Visual Lisp: [Select]

1. (defun c:pldivide (/ ps pe sl tl ang di pts)
2.  
3.   (defun makepline (pt_lst lay clsd) ; clsd must be 1 or 0
4.     (entmakex
5.       (append
6.         (list '(0 . "LWPOLYLINE")
7.               '(100 . "AcDbEntity")
8.               '(100 . "AcDbPolyline")
9.               (cons 8 "0")
10.               (cons 90 (length pt_lst))
11.               (cons 70 clsd) ; 1 for closed 0 overwise
12.         )
13.         (mapcar '(lambda (pt) (cons 10 pt)) pt_lst)
14.       )
15.     )
16.   )
17.  
18.   (if (and (setq ps (getpoint "\nPick Start point."))
19.            (setq pe (getpoint ps "\nPick End point."))
20.            (setq sl (getdist "\nEnter segement length: "))
21.       )
22.     (progn ; create pline
23.       (setq tl  (distance ps pe)
24.             ang (angle ps pe)
25.             pts (list ps)
26.             di  sl
27.       )
28.       (while (< (distance ps (setq p (polar ps ang di))) tl)
29.         (setq di  (+ sl di)
30.               pts (cons p pts)
31.         )
32.       )
33.       (makepline (cons pe pts) (getvar "clayer") 0)
34.     )
35.   )
36.   (princ)
37. )

[Lee Mac]

Another, quick one:

Code - Auto/Visual Lisp: [Select]

1. (defun c:pldiv ( / d1 d2 el i pl sl )
2.     (setq el (entlast))
3.     (command "_.pline")
4.     (while (= 1 (logand 1 (getvar 'CMDACTIVE)))
5.         (command pause)
6.     )
7.     (if
8.         (and
9.             (not (equal el (setq el (entlast))))
10.             (progn
11.                 (initget 6)
12.                 (setq sl (getdist "\nSpecify Segment Length: "))
13.             )
14.         )
15.         (progn
16.             (setq i 0)
17.             (repeat (fix (vlax-curve-getendparam el))
18.                 (setq d1 (vlax-curve-getdistatparam el i)
19.                       d2 (vlax-curve-getdistatparam el (1+ i))
20.                 )
21.                 (while (< d1 d2)
22.                     (setq pl (cons (cons 10 (vlax-curve-getpointatdist el d1)) pl)
23.                           d1 (+ d1 sl)
24.                     )
25.                 )
26.                 (setq i (1+ i))
27.             )
28.             (if
29.                 (entmake
30.                     (append
31.                         (list
32.                            '(0 . "LWPOLYLINE")
33.                            '(100 . "AcDbEntity")
34.                            '(100 . "AcDbPolyline")
35.                             (cons 90 (length pl))
36.                             (assoc 70 (entget el))
37.                         )
38.                         (reverse pl)
39.                     )
40.                 )
41.                 (entdel el)
42.             )
43.         )
44.     )
45.     (princ)
46. )
47. (vl-load-com)

[demesne]

Blimey!  Thanks guys.

They both would save me time.

CAB (or do you prefer Charles?) - your routine missed the last segment meaning the line is shorter than the pick points, but I could live with that. Many thanks.

Lee - works perfectly.  I think I owe you a beer!  Thanks again.

Regards
Demesne

[CAB]

Oops, code updated.

[CAB]

Here is another version for number of segments. (little testing)

Code - Auto/Visual Lisp: [Select]

1. (defun c:pldivide2 (/ ps pe sl sc tl ang di pts)
2.  
3.   (defun makepline (pt_lst lay clsd) ; clsd must be 1 or 0
4.     (entmakex
5.       (append
6.         (list '(0 . "LWPOLYLINE")
7.               '(100 . "AcDbEntity")
8.               '(100 . "AcDbPolyline")
9.               (cons 8 "0")
10.               (cons 90 (length pt_lst))
11.               (cons 70 clsd) ; 1 for closed 0 overwise
12.         )
13.         (mapcar '(lambda (pt) (cons 10 pt)) pt_lst)
14.       )
15.     )
16.   )
17.  
18.   (if (and (setq ps (getpoint "\nPick Start point."))
19.            (setq pe (getpoint ps "\nPick End point."))
20.            (setq sc (getint "\nEnter number of segements : "))
21.       )
22.     (progn ; create pline
23.       (setq tl  (distance ps pe)
24.             ang (angle ps pe)
25.             pts (list ps)
26.             sl  (/ tl sc)
27.             di  sl
28.       )
29.       (while (< (distance ps (setq p (polar ps ang di))) tl)
30.         (setq di  (+ sl di)
31.               pts (cons p pts)
32.         )
33.       )
34.       (makepline (cons pe pts) (getvar "clayer") 0)
35.     )
36.   )
37.   (princ)
38. )

[demesne]

Thanks.  That's how I've always wanted the standard AutoCAD 'divide' command to work.

Excellent!

[Lee Mac]

Lee - works perfectly.  I think I owe you a beer!  Thanks again.

Excellent to hear - you're welcome Demesne 

[alanjt]

Slight, pointless mod on Lee's (entmod rather than entmake+entdel)...

Code: [Select]

(defun c:pldiv (/ d1 d2 el i pl sl)
  (setq el (entlast))
  (command "_.pline")
  (while (= 1 (logand 1 (getvar 'CMDACTIVE)))
    (command pause)
  )
  (if (and (not (equal el (setq el (entlast))))
           (progn (initget 6) (setq sl (getdist "\nSpecify Segment Length: ")))
      )
    (progn
      (setq i 0)
      (repeat (fix (vlax-curve-getendparam el))
        (setq d1 (vlax-curve-getdistatparam el i)
              d2 (vlax-curve-getdistatparam el (1+ i))
        )
        (while (< d1 d2)
          (setq pl (cons (cons 10 (vlax-curve-getpointatdist el d1)) pl)
                d1 (+ d1 sl)
          )
        )
        (setq i (1+ i))
      )
      (entmod (append (vl-remove-if (function (lambda (x) (member (car x) '(10 90)))) (entget el))
                      (cons (cons 90 (length pl)) (reverse pl))
              )
      )
    )
  )
  (princ)
)
(vl-load-com)