Help with LISP - convert diagonal polyline to zig-zag polyline

kwatanabeM7CVP · ‎05-23-2022

Hello,

I am looking for some AutoLISP expert to help with converting a diagonal polyline to a zig-zag polyline.

Something like the diagram below where I can select an angled polyline and convert it to a zig-zag (orthogonal lines), where it bends at the mid-point of the line. If I can select multiple lines and convert them at once, even better.

Or perhaps a LISP function to select two points and draw a a bunch of zig-zag polyline between two points is fine also.

I don't have much knowledge of LISP so I am hoping one of you experts can help me. Thank you!

KW

calderg1000 · ‎05-23-2022

Regards @kwatanabeM7CVP

Try this code

(defun c:PZZ (/ p1 p2 p3 p4)
  (setq p1 (getpoint "\nPick Point 1: ")
        p2 (getpoint p1 "\nPick Point 2: ")
        p3 (list (+ (car p1) (/ (- (car p2) (car p1)) 2)) (cadr p1) 0.)
        p4 (list (+ (car p1) (/ (- (car p2) (car p1)) 2)) (cadr p2) 0.)
  )
  (setq lst (list p1 p3 p4 p2))
  (entmake (append (list
                     (cons 0 "lwpolyline")
                     (cons 100 "AcDbEntity")
                     (cons 100 "AcDbPolyline")
                     (cons 90 4)
                     (cons 70 0)
                   )
                   (mapcar '(lambda (x) (cons 10 x)) lst)
           )
  )
)

Carlos Calderon G

>Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.

kwatanabeM7CVP · ‎05-23-2022

That works great. Thank you calderg1000!

KW

ВeekeeCZ · ‎05-24-2022

This one allows multiple selections. Pline could have multiple segments. It inherits the properties of the originals. Remove the last (noted) line to keep the originals.

(vl-load-com)

(defun c:Ortoline ( / s i e f d l p q o z px)
  
  (if (setq s (ssget "_:L" '((0 . "LWPOLYLINE,LINE"))))
    (repeat (setq i (sslength s))
      (and (setq e (ssname s (setq i (1- i))))
	   (setq d (entget e))
	   (setq l (mapcar 'cdr (if (= "LINE" (cdr (assoc 0 d)))
				  (list (assoc 10 d) (assoc 11 d))
				  (vl-remove-if '(lambda (x) (/= (car x) 10)) d))))
	   (setq f (vlax-ename->vla-object e))
	   (setq z (apply 'append (mapcar '(lambda (x) (if (vlax-property-available-p f x)
							 (list (list x (vlax-get f x)))))
					  '("Color" "Layer" "LineType" "LinetypeScale" "Lineweight"))))
	   (setq l (apply 'append (mapcar '(lambda (p q) (list p
							       (list (/ (+ (car p) (car q)) 2) (cadr p))
							       (list (/ (+ (car p) (car q)) 2) (cadr q))
							       q))
					  l (cdr l))))
	   (setq l (vl-remove 'nil (mapcar '(lambda (x) (if (not (equal x px 1e-6)) (setq px x))) l))) ; remove p if is same as previous one
	   (setq o (entmakex (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length l)) '(70 . 0))
				     (mapcar '(lambda (x) (cons 10 x)) l))))
	   (setq o (vlax-ename->vla-object o))
	   (vlax-write-enabled-p o)
	   (mapcar '(lambda (x) (vl-catch-all-apply 'vlax-put (list o (car x) (cadr x)))) z)
	   (entdel e) ; remove this line to keep the originals
	   )))
  (princ)
  )

Kent1Cooper · ‎05-24-2022

Another approach:

(defun C:PLOJ ; = PolyLine Orthogonal Jog
  (/ ss n pl pldata start end midX)
  (if (setq ss (ssget "_:L" '((0 . "LWPOLYLINE"))))
    (repeat (setq n (sslength ss))
      (setq
        pl (ssname ss (setq n (1- n)))
        pldata (entget pl)
        start (cdr (assoc 10 pldata))
        end (cdr (assoc 10 (reverse pldata)))
        midX (/ (+ (car start) (car end)) 2)
      ); setq
      (vlax-put (vlax-ename->vla-object pl) 'Coordinates
        (append start (list midX (cadr start) midX (cadr end)) end)
      ); ..put
    ); repeat
  ); if
  (princ)
); defun

Multiple selection;

Goes from start to end with jog, regardless of shape of selected Polyline;

Simply modifies the coordinates, so has no effect on Layer or any other properties, and no need to delete originals.

Kent Cooper, AIA

kwatanabeM7CVP · ‎05-24-2022

Looks like it can be useful to convert complicated polyline to become orthogonal polyline. Thank you.

KW

kwatanabeM7CVP · ‎05-24-2022

Thank you! - looks to be very efficient coding.

KW

Gobel_A · ‎10-19-2023

@ВeekeeCZ this is perfect lisp for using in electrical drawing for draw a fire alarm loop. Is there a possibility to edit this script to draw only "L" shape, not the zigzag ? For simplicity, it would be enough if the first polyline always starts sideways (left or right) or, if possible, with the option to choose if sideways or up/down

ВeekeeCZ · ‎10-19-2023

My routine actually CONVERTS lines to polylines. You say to want to DRAW a polyline... So what is it? Convert?

Gobel_A · ‎10-19-2023

I meant the original purpose of this topic, i.e. to convert a diagonal polyline into an "ortho Z" but with modification to "ortho L".
I have a LISP that connects all selected blocks by the shortest path. The result is a continuous polyline connecting the blocks. If they are exactly side by side, it will connect them straight, if they are skewed in the X or Y axis, it will connect them diagonally with the shortest path. Your "ortoline" script nicely converts this diagonally connecting polyline with vertices in each block to an "ortho Z" shape. Perfectly. And my question was if there is a possibility to modify it to an "ortho L" shape with a choice of one of two possible interconnection options.

Kent1Cooper · ‎10-19-2023

@Gobel_A wrote:

.... "L" shape.... it would be enough if the first polyline always starts sideways (left or right) or, if possible, with the option to choose if sideways or up/down

That would be affected by the direction in which the source object is drawn. If the dotted green is the original, with the arrow showing its drawn direction, then if you choose to start with the horizontal leg, and that is from the start point of the source, you would get different white results:

Might you want to have the choice be in the starting direction from whichever end is lower? Or whichever end is farther to the left? Some other criterion?

Kent Cooper, AIA

Gobel_A · ‎10-19-2023

command 1: always start sideways (right/left) and then connect the second block up or down
command 2: always start up or down in the direction of the polyline and then connect the second block from the side

Something similar to teh script on the link bellow, but for the entire path of the original polyline. Something similar to the link, but the skript from the link connects according to its own logic and not the direction of the original polyline.

https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/connecting-blocks-with-polyline-help...

ВeekeeCZ · ‎10-19-2023

Ok, simple edits... one version is HV, the second VH.

(vl-load-com)

(defun c:OrtolineHV ( / s i e f d l p q o z px)
  
  (if (setq s (ssget "_:L" '((0 . "LWPOLYLINE,LINE"))))
    (repeat (setq i (sslength s))
      (and (setq e (ssname s (setq i (1- i))))
	   (setq d (entget e))
	   (setq l (mapcar 'cdr (if (= "LINE" (cdr (assoc 0 d)))
				  (list (assoc 10 d) (assoc 11 d))
				  (vl-remove-if '(lambda (x) (/= (car x) 10)) d))))
	   (setq f (vlax-ename->vla-object e))
	   (setq z (apply 'append (mapcar '(lambda (x) (if (vlax-property-available-p f x)
							 (list (list x (vlax-get f x)))))
					  '("Color" "Layer" "LineType" "LinetypeScale" "Lineweight"))))
	   (setq l (apply 'append (mapcar '(lambda (p q) (list p
							       (list (car q) (cadr p))
							       q))
					  l (cdr l))))
	   (setq l (vl-remove 'nil (mapcar '(lambda (x) (if (not (equal x px 1e-6)) (setq px x))) l))) ; remove p if is same as previous one
	   (setq o (entmakex (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length l)) '(70 . 0))
				     (mapcar '(lambda (x) (cons 10 x)) l))))
	   (setq o (vlax-ename->vla-object o))
	   (vlax-write-enabled-p o)
	   (mapcar '(lambda (x) (vl-catch-all-apply 'vlax-put (list o (car x) (cadr x)))) z)
	   (entdel e) ; remove this line to keep the originals
	   )))
  (princ)
  )


(defun c:OrtolineVH ( / s i e f d l p q o z px)
  
  (if (setq s (ssget "_:L" '((0 . "LWPOLYLINE,LINE"))))
    (repeat (setq i (sslength s))
      (and (setq e (ssname s (setq i (1- i))))
	   (setq d (entget e))
	   (setq l (mapcar 'cdr (if (= "LINE" (cdr (assoc 0 d)))
				  (list (assoc 10 d) (assoc 11 d))
				  (vl-remove-if '(lambda (x) (/= (car x) 10)) d))))
	   (setq f (vlax-ename->vla-object e))
	   (setq z (apply 'append (mapcar '(lambda (x) (if (vlax-property-available-p f x)
							 (list (list x (vlax-get f x)))))
					  '("Color" "Layer" "LineType" "LinetypeScale" "Lineweight"))))
	   (setq l (apply 'append (mapcar '(lambda (p q) (list p
							       (list (car p) (cadr q))
							       q))
					  l (cdr l))))
	   (setq l (vl-remove 'nil (mapcar '(lambda (x) (if (not (equal x px 1e-6)) (setq px x))) l))) ; remove p if is same as previous one
	   (setq o (entmakex (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length l)) '(70 . 0))
				     (mapcar '(lambda (x) (cons 10 x)) l))))
	   (setq o (vlax-ename->vla-object o))
	   (vlax-write-enabled-p o)
	   (mapcar '(lambda (x) (vl-catch-all-apply 'vlax-put (list o (car x) (cadr x)))) z)
	   (entdel e) ; remove this line to keep the originals
	   )))
  (princ)
  )

calderg1000 · ‎10-19-2023

Regards @Gobel_A

try this code, it gives you the option to choose, up or down.

(defun c:PL_TB(/ p1 p2 p3 opc lst)
  (princ "\nSelect Start Block: ")
  (setq
    p1 (cdr
         (assoc 10 (entget (ssname (ssget "_+.:E:S" '((0 . "insert"))) 0)))  
       )
  )
  (while
    (princ "\nSelect Next Block/Right Click for End: ")
    (setq
      p2 (cdr
           (assoc 10 (entget (ssname (ssget "_+.:E:S" '((0 . "insert"))) 0)))
         )
    )
     (if (< (cadr p1) (cadr p2))
       (progn
         (setq pn1 p1
               pn2 p2
         )
       )
       (progn
         (setq pn1 p2
               pn2 p1
         )
       )
     )
    
     (initget "Tp Bt")
     (setq opc    (if
                    (setq opc (getkword "\n Select Top/Botton [Top / Botton]: <Tp>"))
                     opc
                     "Tp"
                  )
           *oopc* opc
     )
     (if (= opc "Tp")
       (setq p3t (list (car pn1) (cadr pn2) 0.)
       )
     )
     (if (= opc "Bt")
       (setq p3t (list (car pn2) (cadr pn1) 0.)
       )
     )
     (setq lst (list pn1 p3t pn2))
     (entmake (append (list
                        (cons 0 "lwpolyline")
                        (cons 100 "AcDbEntity")
                        (cons 100 "AcDbPolyline")
                        (cons 90 4)
                        (cons 70 0)
                      )
                      (mapcar '(lambda (x) (cons 10 x)) lst)
              )
     )
     (setq p1 p2)
  )
)

,

Carlos Calderon G

>Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.

Gobel_A · ‎10-20-2023

many thanks, this is something what i was asking for and gives more flexibility in choosing the "direction"

Community

Help with LISP - convert diagonal polyline to zig-zag polyline

Help with LISP - convert diagonal polyline to zig-zag polyline

Help with LISP - convert diagonal polyline to zig-zag polyline