Jump to content

zigzag line TO straight line

mstb

By mstb
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

mstb Enthusiast

mstb

Posted
Posted (edited)

hello every one

I want to make a zigzag line a straight line

My goal is to draw the two-line effects that are usually picked up during zigzag harvest.

Of course, this may not be complete zigzag and may be directly harvested in some places

I was almost able to do this from the zigzag line drawn from left to right or vice versa

But it doesn't work when it's up or down 

(defun test ()
  (setq s s1)
  (setq en (entget s))
  (entdel (entlast))
  (setq li nil)
  (setq lii nil)
  (setq ili nil)
  (setq lil nil)
  (setq lli nil)
  (foreach a en
    (cond ((= (car a) 10)
	   (setq po (cdr a))
	   (setq li (append li (list po)))
	   (setq lio (append lio (list po)))
	  )
    )
  )
  (setq li0 nil)
  (setq li1 nil)
  (setq li00 nil)
  (setq li11 nil)
  (setq first (car li))
  (setq lastt (last li))
  (setq lii (cdr li))
  (setq lii (append lii (list (car li))))
  (setq firstt (car lii))
  (setq lil (cdr lii))
  (setq lil (append lil (list (car lii))))
  (setq ili (mapcar 'list li lii lil))
  (setq i 0)
  (setq j 0)
  (foreach a ili
    (setq i (1+ i))
    (setq p1 (car a))
    (setq p2 (cadr a))
    (setq p3 (caddr a))
    (cond
      ((and (> (abs (- (angle p1 p2) (angle p2 p3))) (* pi 0.25))
	    ;;(< (abs (- (angle p1 p2) (angle p2 p3))) (* pi 1.75))
	    (= j 0)
       )
       (setq j 1)
       (setq lli (append lli (list (list i p3 p2))))
      )
      ((= j 1) (setq j 0))
    )
  )
  (setq li (LM:SubstNth (cadr (car lli)) 0 li))
  (setq li (LM:SubstNth (caddr (car lli)) (1+ (car (car lli))) li))
  (setq nn (length li))
  (setq li (LM:SubstNth (last lio) (1- nn) li))
  (command "pline")
  (foreach po li (command po))
  (command "")
)



(defun c:aaa ()
  (setvar "osmode" 0)
  (setq s (car (entsel)))
  (setq en (entget s))
  (entdel s)
  (setq li nil)
  (setq lii nil)
  (setq liii nil)
  (setq ili nil)
  (setq lil nil)
  (setq lli nil)
  (foreach a en
    (cond ((= (car a) 10)
	   (setq po (cdr a))
	   (setq li (append li (list po)))
	   (setq liii (append li (list po)))
	   (setq lio (append lio (list po)))
	  )
    )
  )
  (setq li0 nil)
  (setq li1 nil)
  (setq li00 nil)
  (setq li11 nil)
  (setq first (car li))
  (setq lastt (last li))
  (setq lii (cdr li))
  (setq lii (append lii (list (car li))))
  (setq firstt (car lii))
  (setq lil (cdr lii))
  (setq lil (append lil (list (car lii))))
  (setq ili (mapcar 'list li lii lil))
  (setq i 0)
  (setq j 0)
  (foreach a ili
    (setq i (1+ i))
    (setq p1 (car a))
    (setq p2 (cadr a))
    (setq p3 (caddr a))
    (cond
      ((and (> (abs (- (angle p1 p2) (angle p2 p3))) (* pi 0.25))
	    ;;(< (abs (- (angle p1 p2) (angle p2 p3))) (* pi 1.75))
	    (= j 0)
       )
       (setq j 1)
       (setq lli (append lli (list (list i p3 p2))))
      )
      ((= j 1) (setq j 0))
    )
  )
  (setq li (LM:SubstNth (cadr (car lli)) 0 li))
  (setq li (LM:SubstNth (caddr (car lli)) (1+ (car (car lli))) li))
  (setq nn (length li))
  (setq li (LM:SubstNth (last lio) (1- nn) li))
  (setq li (vl-remove (car li) li))
  (command "pline")
  (foreach po li (command po))
  (command "")
  (repeat (- (length li) 0)
    (setq s1 (entlast))
    (test)
  )
  (setq s2 (entlast))
  (setq en2 (entget s2))
  (setq li2 nil)
  (setq lii2 nil)
  (setq ili2 nil)
  (setq lil2 nil)
  (setq lli2 nil)
  (foreach a en2
    (cond ((= (car a) 10)
	   (setq po2 (cdr a))
	   (setq li2 (append li2 (list po2)))
	  )
    )
  )
  (foreach a li2
    (setq liii (vl-remove a liii))
  )
  (command "pline")
  (foreach po liii (command po))
  (command "")
  (princ)
)
(defun LM:SubstNth (aa n l / j)
  (setq j -1)
  (mapcar '(lambda (x)
	     (if (= (setq j (1+ j)) n)
	       aa
	       x
	     )
	   )
	  l
  )
)

excuse me for my bad english

Thanks all

 

zigzag.bmp

Edited by mstb
Link to comment
Share on other sites
Jonathan Handojo Experienced

Jonathan Handojo

Posted
Posted

From the looks of things, can you just take the first and second last point, and then the second and last point, then draw a straight line on them?

Link to comment
Share on other sites
mstb Enthusiast

mstb

Posted
  • Author
Posted
1 hour ago, Jonathan Handojo said:

From the looks of things, can you just take the first and second last point, and then the second and last point, then draw a straight line on them?

Not in order

Link to comment
Share on other sites
marko_ribar Veteran

marko_ribar

Posted
Posted
34 minutes ago, mstb said:

Not in order

 

What is not in order ? You convert LINES to JOINED LWPOLYLINE, then you take start/end points, create LINE and remove LWPOLYLINE... And BTW, ZIG-ZAG can be drawn at any angle, not just horizontal or vertical...

Link to comment
Share on other sites
Jonathan Handojo Experienced

Jonathan Handojo

Posted
Posted
2 hours ago, mstb said:

Not in order

 

Like marko_ribar pointed out, if you join the line to polyline, the sequence of points will definitely be in sequence.

Link to comment
Share on other sites
Stefan BMR Proficient

Stefan BMR

Posted
Posted

MSTB, I hope each zigzag color is a Polyline.

The lisp works in your sample, but for other situation it might fail.

The zigzag line must follow an imaginary line, like you are crossing left-right this line, and the result 2 plines must be approximately straight and parallel :) 

(defun C:TEST (/ e l w o s a l1 l2)
  (while
    (setq e (car (entsel "\nSelect polyline: ")))
    (if
      (eq (cdr (assoc 0 (setq e (entget e)))) "LWPOLYLINE")
      (progn
        (setq w (vl-remove-if-not
                 '(lambda (x)
                    (member (car x) '(0 100 8 62))
                  )
                  e
                )
              l (mapcar 'cdr
                  (vl-remove-if
                   '(lambda (x) (/= (car x) 10))
                    e
                  )
                )
              s (length l)
              o (mapcar '/ (apply 'mapcar (cons '+ l)) (list s s))
              l (mapcar '(lambda (p) (mapcar '- p o)) l)
              a (dir2D l)
              l1 nil l2 nil
        )
        (foreach p (reverse l)
          (if
            (< (* (cadr p) (cos a)) (* (car p) (sin a)))
            (setq l1 (cons (cons 10 (mapcar '+ p o)) l1))
            (setq l2 (cons (cons 10 (mapcar '+ p o)) l2))
          )
        )
        (entmakex (append w (list (cons 90 (length l1)) '(70 . 0)) l1))
        (entmakex (append w (list (cons 90 (length l2)) '(70 . 0)) l2))
      )
    )
  )
  (princ)
)

(defun vxv (a b) (apply '+ (mapcar '* a b)))

(defun dir2D (l / dx dy a)
  (setq dx (mapcar 'car l)
        dy (mapcar 'cadr l)
        a  (* 0.5 (atan (* 2 (vxv dx dy)) (- (vxv dx dx) (vxv dy dy))))
  )
)

 

 

Link to comment
Share on other sites
mstb Enthusiast

mstb

Posted
  • Author
Posted
4 hours ago, Stefan BMR said:

MSTB, I hope each zigzag color is a Polyline.

The lisp works in your sample, but for other situation it might fail.

The zigzag line must follow an imaginary line, like you are crossing left-right this line, and the result 2 plines must be approximately straight and parallel :) 


(defun C:TEST (/ e l w o s a l1 l2)
  (while
    (setq e (car (entsel "\nSelect polyline: ")))
    (if
      (eq (cdr (assoc 0 (setq e (entget e)))) "LWPOLYLINE")
      (progn
        (setq w (vl-remove-if-not
                 '(lambda (x)
                    (member (car x) '(0 100 8 62))
                  )
                  e
                )
              l (mapcar 'cdr
                  (vl-remove-if
                   '(lambda (x) (/= (car x) 10))
                    e
                  )
                )
              s (length l)
              o (mapcar '/ (apply 'mapcar (cons '+ l)) (list s s))
              l (mapcar '(lambda (p) (mapcar '- p o)) l)
              a (dir2D l)
              l1 nil l2 nil
        )
        (foreach p (reverse l)
          (if
            (< (* (cadr p) (cos a)) (* (car p) (sin a)))
            (setq l1 (cons (cons 10 (mapcar '+ p o)) l1))
            (setq l2 (cons (cons 10 (mapcar '+ p o)) l2))
          )
        )
        (entmakex (append w (list (cons 90 (length l1)) '(70 . 0)) l1))
        (entmakex (append w (list (cons 90 (length l2)) '(70 . 0)) l2))
      )
    )
  )
  (princ)
)

(defun vxv (a b) (apply '+ (mapcar '* a b)))

(defun dir2D (l / dx dy a)
  (setq dx (mapcar 'car l)
        dy (mapcar 'cadr l)
        a  (* 0.5 (atan (* 2 (vxv dx dy)) (- (vxv dx dx) (vxv dy dy))))
  )
)

Thank You very much

 

 

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...