topic Re: Need lisp for polyline in Visual LISP, AutoLISP and General Customization Forum

Need lisp for polyline

kajanthangavel — Wed, 19 Dec 2018 12:56:17 GMT

I am in a need for a lisp that can draw a specific polyline like shown Picture.

Re: Need lisp for polyline

CodeDing — Wed, 19 Dec 2018 14:32:57 GMT

@kajanthangavel,

Will your new (white) polyline ever step down?

Is the change in Y always 0.15 units?

Best,

~DD

Re: Need lisp for polyline

CodeDing — Wed, 19 Dec 2018 16:36:45 GMT

@kajanthangavel,

That was a fun bit of a challenge for me. It may not be ideal code, but it works and it's pretty quick.

Best,

~DD

(defun c:STEP ( / ptList lineList ptNow ptNext ptTmp ptInt e x isNeg)
;Created by CodeDing 12/19/18
(if (eq (cdr (assoc 0 (entget (setq e (car (entsel "\nSelect Polyline: ")))))) "LWPOLYLINE")
	(foreach x (entget e) (if (= 10 (car x)) (setq ptList (cons (list (cadr x) (caddr x)) ptList))))
  	(progn (prompt "\nPolyline not selected.") (exit)))
(command "_.ZOOM" "o" e "")

(setq ptList (vl-sort ptList (function (lambda ( a b ) (< (car a) (car b))))))
(setq ptNow (nth 0 ptList))
(setq ptTmp ptNow)
(setq lineList (cons ptNow lineList))

(while (and (> (length ptList) 1) (not isNeg))
  	(setq ptNext (nth 1 ptList))
	(while (>= (- (cadr ptNext) (cadr ptTmp)) 0.15)
		(setq ptInt (inters ptNow ptNext (list (car ptTmp) (+ 0.15 (cadr ptTmp))) (list (+ 1.0 (car ptTmp)) (+ 0.15 (cadr ptTmp))) nil))
	    	(setq lineList (reverse (cons (list (car ptInt) (cadr ptTmp)) (reverse lineList))))
	    	(setq lineList (reverse (cons ptInt (reverse lineList))))
		(setq ptTmp ptInt)
	);while
  	(if (> 0 (- (cadr ptNext) (cadr ptNow)))
	  (progn
		(setq isNeg t)
	    	(setq ptInt (inters ptNow ptNext ptInt (list (+ 1.0 (car ptInt)) (cadr ptInt)) nil))
	    	(setq lineList (reverse (cons ptInt (reverse lineList))))
	  );progn
	  	(setq ptNow ptNext ptList (vl-remove (nth 0 ptList) ptList))
	);if
);while
(if (listp lineList)
  (LWPoly lineList 0)
  (prompt "\nNo line Generated.")
);if
(prompt "\nSTEP Complete.")
(princ)
);defun

(defun LWPoly (lst cls)
;Originally created by Lee Mac
 (entmakex (append (list (cons 0 "LWPOLYLINE")
                         (cons 100 "AcDbEntity")
                         (cons 100 "AcDbPolyline")
                         (cons 90 (length lst))
                         (cons 70 cls))
                   (mapcar (function (lambda (p) (cons 10 p))) lst))))

Re: Need lisp for polyline

CodeDing — Wed, 19 Dec 2018 22:48:15 GMT

Forgot to include turning off OSNAPs...

(defun c:STEP ( / osm ptList lineList ptNow ptNext ptTmp ptInt e x isNeg)
;Created by CodeDing 12/19/18
(if (eq (cdr (assoc 0 (entget (setq e (car (entsel "\nSelect Polyline: ")))))) "LWPOLYLINE")
	(foreach x (entget e) (if (= 10 (car x)) (setq ptList (cons (list (cadr x) (caddr x)) ptList))))
  	(progn (prompt "\nPolyline not selected.") (exit)))
(command "_.ZOOM" "o" e "")

(setq osm (getvar 'OSMODE))
(setvar 'OSMODE 0)
(setq ptList (vl-sort ptList (function (lambda ( a b ) (< (car a) (car b))))))
(setq ptNow (nth 0 ptList))
(setq ptTmp ptNow)
(setq lineList (cons ptNow lineList))

(while (and (> (length ptList) 1) (not isNeg))
  	(setq ptNext (nth 1 ptList))
	(while (>= (- (cadr ptNext) (cadr ptTmp)) 0.15)
		(setq ptInt (inters ptNow ptNext (list (car ptTmp) (+ 0.15 (cadr ptTmp))) (list (+ 1.0 (car ptTmp)) (+ 0.15 (cadr ptTmp))) nil))
	    	(setq lineList (reverse (cons (list (car ptInt) (cadr ptTmp)) (reverse lineList))))
	    	(setq lineList (reverse (cons ptInt (reverse lineList))))
		(setq ptTmp ptInt)
	);while
  	(if (> 0 (- (cadr ptNext) (cadr ptNow)))
	  (progn
		(setq isNeg t)
	    	(setq ptInt (inters ptNow ptNext ptInt (list (+ 1.0 (car ptInt)) (cadr ptInt)) nil))
	    	(setq lineList (reverse (cons ptInt (reverse lineList))))
	  );progn
	  	(setq ptNow ptNext ptList (vl-remove (nth 0 ptList) ptList))
	);if
);while
(if (listp lineList)
  (LWPoly lineList 0)
  (prompt "\nNo line Generated.")
);if
(setvar 'OSMODE osm)
(prompt "\nSTEP Complete.")
(princ)
);defun

(defun LWPoly (lst cls)
;Originally created by Lee Mac
 (entmakex (append (list (cons 0 "LWPOLYLINE")
                         (cons 100 "AcDbEntity")
                         (cons 100 "AcDbPolyline")
                         (cons 90 (length lst))
                         (cons 70 cls))
                   (mapcar (function (lambda (p) (cons 10 p))) lst))))

Re: Need lisp for polyline

kajanthangavel — Thu, 20 Dec 2018 03:03:16 GMT

I am Working in a Road construction company. That "150mm" thickness soil can be compacted well. so i need to cut like that at the road.

Re: Need lisp for polyline

kajanthangavel — Thu, 20 Dec 2018 03:13:21 GMT

Thank you to for reply.

But, this lisp working only single straight polyline. but i need to apply many vertex polyline..

Re: Need lisp for polyline

CodeDing — Thu, 20 Dec 2018 12:27:41 GMT

@kajanthangavel,

That lisp definitely works on multi-vertex polylines.

...however, it will not effectively work on polylines with arcs...

Best,

~DD

Re: Need lisp for polyline

Kent1Cooper — Thu, 20 Dec 2018 14:09:30 GMT

I would like to reiterate @CodeDing's first question in Message 2, which the routine does not handle [left side of image below]. And would the Polyline ever slope the other way [right side]? The routine also doesn't work in that situation.

Even if it generally slopes upward from left to right, if it goes downward first before going predominantly upward, the same error occurs.

These don't matter if you never have such situations, but that doesn't seem likely in the real world.

Re: Need lisp for polyline

Kent1Cooper — Thu, 20 Dec 2018 15:58:17 GMT

@Kent1Cooper wrote:

I would like to reiterate @CodeDing's first question in Message 2, which the routine does not handle .... And would the Polyline ever slope the other way [right side]? The routine also doesn't work in that situation. ....

Try this:

(defun C:STEP-15 (/ *error* doc svnames svvals ss n plobj LL xl xlobj intc pts)
;; Kent Cooper 12/20/18
  (defun *error* (errmsg)
    (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break"))
      (princ (strcat "\nError: " errmsg))
    ); if
    (mapcar 'setvar svnames svvals); reset System Variables
    (vla-endundomark doc)
    (princ)
  ); defun - *error*
  (vla-startundomark (setq doc (vla-get-activedocument (vlax-get-acad-object))))
  (setq
    svnames '(osmode cmdecho blipmode plinewid)
    svvals (mapcar 'getvar svnames)
  ); setq
  (prompt "\nTo draw 0.15-height under-side steps along Polyline(s),")
  (if (setq ss (ssget '((0 . "*POLYLINE"))))
    (progn ; then
      (mapcar 'setvar svnames '(0 0 0 0))
        ; turn off Osnap, command echoing, blips; set Pline width to 0
      (repeat (setq n (sslength ss))
        (setq
          pts nil ; [reset from previous]
          plobj (vlax-ename->vla-object (ssname ss (setq n (1- n))))
        ); setq
        (vla-getboundingbox plobj 'minpt 'maxpt)
        (setq LL (vlax-safearray->list minpt)); setq
        (command "_.xline" "_hor" LL "")
        (setq xl (entlast) xlobj (vlax-ename->vla-object xl))
        (repeat (1+ (fix (/ (- (cadr (vlax-safearray->list maxpt)) (cadr LL)) 0.15)))
          (setq intc (vlax-invoke plobj 'IntersectWith xlobj acExtendNone))
          (while intc
            (setq
              pts (cons (list (car intc) (cadr intc) (caddr intc)) pts)
              intc (cdddr intc); to next [if any]
            ); setq
          ); while
          (command "_.move" xl "" "0,0.15" ""); next level upward
        ); repeat
        (entdel xl); remove level-stepping Xline
        (if (> (length pts) 1); i.e. Polyline had enough vertical extent for >1 levels
          (progn ; then
            (setq pts (vl-sort pts '(lambda (a b) (< (car a) (car b))))); left-to-right order
            (command "_.pline" (car pts)); start at left-most point
            (while (> (length pts) 1); still at least 2 points left
              (command
                (if (< (cadar pts) (cadadr pts)); current point lower than next point?
                  (list (caadr pts) (cadar pts)); then -- X of next point, Y of current point
                  (list (caar pts) (cadadr pts)); else -- X of current point, Y of next point
                ); if
                (cadr pts); then next point
              ); command
              (setq pts (cdr pts)); remove current point
            ); while
            (command (car pts) ""); finish Polyline
          ); progn
        ); if
      ); repeat [each Polyline]
    ); progn
    (prompt "\nNo Polyline(s) selected."); else
  ); if [selection]
  (mapcar 'setvar svnames svvals); reset System Variables
  (vla-endundomark doc)
  (princ)
); defun -- C:STEP-15

It works with Polylines containing arc segments:

and with ones that slope in either direction, or that reverse vertical direction:

and note there that it always touches, and bases its 0.15-height stepping from, the lowest point in the Polyline's vertical extent, which in the case above is the right end. If a Polyline goes downward and then back upward again, but where that dip is not the lowest point [here, the "path" extends lower outside the image] it can result in a stepped Polyline that is in part above the "path" Polyline:

though it does have vertices on it. I suppose it might be possible to revise it to step downward another level across that space, if appropriate.

You can select more than one Polyline in or parallel to the current drawing plane [of any variety, but if 3D, they must be planar], and it will do all of them at once. It draws the stepped one on the current Layer, at constant zero width regardless of the current PLINEWID setting.

It could be adjusted to ask for a stepping height, rather than have the 0.15 built in, and/or could be made to work with planar Polylines not parallel to the current XY plane, and/or with other "path" object types [Lines, Splines, Arcs, etc.].

Re: Need lisp for polyline

kajanthangavel — Fri, 21 Dec 2018 05:57:29 GMT

Thank you so much Kent1Cooper and CodeDing also.

I found Good lisp. It save my time.

Re: Need lisp for polyline

Anonymous — Sun, 05 Sep 2021 10:52:43 GMT

Hi @Kent1Cooper , @kajanthangavel , @CodeDing !

thats such a great lisp - awesome work!!!! Would it be possible to start the steps instead of the lowest point of the polyline, from the highest? I tried to flip the coordiante system around the z-axis (180°) - but my simple (stupid) idea didn`t work:-).

best wishes

Stephan

Re: Need lisp for polyline

Kent1Cooper — Sun, 05 Sep 2021 23:01:47 GMT

@Anonymous wrote:

.... Would it be possible to start the steps instead of the lowest point of the polyline, from the highest? ....

Try this [minimally tested]:

(defun C:STEP-15 (/ *error* doc svnames svvals ss n plobj UR xl xlobj intc pts) ;; Kent Cooper 12/20/18 (defun *error* (errmsg) (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break")) (princ (strcat "\nError: " errmsg)) ); if (mapcar 'setvar svnames svvals); reset System Variables (vla-endundomark doc) (princ) ); defun - *error* (vla-startundomark (setq doc (vla-get-activedocument (vlax-get-acad-object)))) (setq svnames '(osmode cmdecho blipmode plinewid) svvals (mapcar 'getvar svnames) ); setq (prompt "\nTo draw 0.15-height under-side steps along Polyline(s),") (if (setq ss (ssget '((0 . "*POLYLINE")))) (progn ; then (mapcar 'setvar svnames '(0 0 0 0)) ; turn off Osnap, command echoing, blips; set Pline width to 0 (repeat (setq n (sslength ss)) (setq pts nil ; [reset from previous] plobj (vlax-ename->vla-object (ssname ss (setq n (1- n)))) ); setq (vla-getboundingbox plobj 'minpt 'maxpt) (setq UR (vlax-safearray->list maxpt)); setq (command "_.xline" "_hor" UR "") (setq xl (entlast) xlobj (vlax-ename->vla-object xl)) (repeat (1+ (fix (/ (- (cadr UR) (cadr (vlax-safearray->list minpt))) 0.15))) (setq intc (vlax-invoke plobj 'IntersectWith xlobj acExtendNone)) (while intc (setq pts (cons (list (car intc) (cadr intc) (caddr intc)) pts) intc (cdddr intc); to next [if any] ); setq ); while (command "_.move" xl "" "0,-0.15" ""); next level downward ); repeat (entdel xl); remove level-stepping Xline (if (> (length pts) 1); i.e. Polyline had enough vertical extent for >1 levels (progn ; then (setq pts (vl-sort pts '(lambda (a b) (< (car a) (car b))))); left-to-right order (command "_.pline" (car pts)); start at left-most point (while (> (length pts) 1); still at least 2 points left (command (if (< (cadar pts) (cadadr pts)); current point lower than next point? (list (caadr pts) (cadar pts)); then -- X of next point, Y of current point (list (caar pts) (cadadr pts)); else -- X of current point, Y of next point ); if (cadr pts); then next point ); command (setq pts (cdr pts)); remove current point ); while (command (car pts) ""); finish Polyline ); progn ); if ); repeat [each Polyline] ); progn (prompt "\nNo Polyline(s) selected."); else ); if [selection] (mapcar 'setvar svnames svvals); reset System Variables (vla-endundomark doc) (princ) ); defun -- C:STEP-15

If you want to have both varieties available, change the command name in one of them.

Re: Need lisp for polyline

Sea-Haven — Mon, 06 Sep 2021 03:56:13 GMT

It appears we are talking about roads here so rather than fix up the cross sections I would suggest do it at the design stage software like "Civil Site Design" has "Intelligent sections" that does the task of multi facet batters for you. The advantage is stuff like volumes etc.

Do a google for "Intelligent sections Civil Site Designs" there are some youtube videos.

Re: Need lisp for polyline

Anonymous — Mon, 06 Sep 2021 07:59:48 GMT

Hi @Kent1Cooper !

Wow - thank you sooo much - it works. Would it be complicate to install a short request in the AutoCAD commando line for inserting a individual high for the steps? Otherwise I only have to change the value 0.15 in the lisp-code - not that bing deal - thats even possible for me :).

kind regards from Germany

Stephan

Re: Need lisp for polyline

Kent1Cooper — Mon, 06 Sep 2021 11:33:05 GMT

@Anonymous wrote:

.... Would it be complicate to install a short request in the AutoCAD commando line for inserting a individual high for the steps? ....

That is probably not complicated, but I'm not quite sure exactly what you mean by it. Can you post an image or sample drawing pointing with notes indicating what you're starting with and the kind of result you want?