Get All lines and trace them all

Get All lines and trace them all

rpajounia
Advocate Advocate
788 Views
8 Replies
Message 1 of 9

Get All lines and trace them all

rpajounia
Advocate
Advocate

Is there a lisp function that can trace all lines. For example like a CAM software. Also if possible can we have it start from a certain point as well?

0 Likes
789 Views
8 Replies
Replies (8)
Message 2 of 9

hak_vz
Advisor
Advisor

If your lines are all connected use command bpoly and create polyline that joins them all, or use command join.

To set polyline start break it at desired start point.

I hope this is what you are looking for. Otherwise post a sample drawing with before and after state. I'm not working with CAM software so sample drawing can help us all to find solution to your problem.

Miljenko Hatlak

EESignature

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.
0 Likes
Message 3 of 9

Sea-Haven
Mentor
Mentor

If you drew random lines then could find start and end of lines and draw a joining line but it may look like spaghetti.

 

What would be the rules to join.

0 Likes
Message 4 of 9

marko_ribar
Advisor
Advisor

Thanks, Miljenko...

That your observation influenced on me to update my old (c:chiv) - change initial vertex LSP... Now it's tweaked for all closed POLYLINE types...

Regards, M.R.

 

(defun c:chiv ( / chiv ss pt rf )

  (or (not (vl-catch-all-error-p (vl-catch-all-apply (function vlax-get-acad-object) nil))) (vl-load-com))

  (defun chiv ( pl pt / pp ptt bulge )

    (defun pp ( pl p / par )
      (if
        (and
          (setq par (float (+ (fix (vlax-curve-getparamatpoint pl (trans p 1 0))) 0.5)))
          (not (equal (float (fix par)) (vlax-curve-getendparam pl) 1e-6))
        )
        (list
          (trans (vlax-curve-getpointatparam pl (rem (- par 0.1) (vlax-curve-getendparam pl))) 0 1)
          (trans (vlax-curve-getpointatparam pl (rem (+ par 0.1) (vlax-curve-getendparam pl))) 0 1)
        )
      )
    )

    (if 
      (and
        (vlax-curve-isclosed pl)
        (not (equal pt (trans (vlax-curve-getendpoint pl) 0 1) 1e-6))
      )
      (progn
        (setq pt
          (trans
            (vlax-curve-getpointatparam pl
              (float (fix (- (vlax-curve-getparamatpoint pl (vlax-curve-getclosestpointto pl (trans pt 1 0))) 0.5)))
            )
            0 1
          )
        )
        (if (setq p (pp pl pt))
          (progn
            (if (vlax-method-applicable-p (vlax-ename->vla-object pl) 'getbulge)
              (setq bulge (vla-getbulge (vlax-ename->vla-object pl) (fix (vlax-curve-getparamatpoint pl (trans (car p) 1 0)))))
            )
            (if command-s
              (command-s "_.BREAK" pl "_non" (car p) "_non" (cadr p))
              (vl-cmdf "_.BREAK" pl "_non" (car p) "_non" (cadr p))
            )
            (if command-s
              (command-s "_.TRIM" pl "" "_non" (trans (vlax-curve-getpointatparam pl 0.1) 0 1) "_non" (trans (vlax-curve-getpointatparam pl (- (vlax-curve-getendparam pl) 0.1)) 0 1) "")
              (vl-cmdf "_.TRIM" pl "" "_non" (trans (vlax-curve-getpointatparam pl 0.1) 0 1) "_non" (trans (vlax-curve-getpointatparam pl (- (vlax-curve-getendparam pl) 0.1)) 0 1) "")
            )
            (if (not (equal pt (trans (vlax-curve-getstartpoint pl) 0 1) 1e-6))
              (progn
                (if command-s
                  (command-s "_.PEDIT" pl "" "_R")
                  (vl-cmdf "_.PEDIT" pl "" "_R")
                )
                (while (< 0 (getvar (quote cmdactive)))
                  (vl-cmdf "")
                )
                (setq rf t)
              )
            )
            (vla-put-closed (vlax-ename->vla-object pl) :vlax-true)
            (if (vlax-method-applicable-p (vlax-ename->vla-object pl) 'getbulge)
              (vla-setbulge (vlax-ename->vla-object pl) (1- (vlax-curve-getendparam pl)) bulge)
            )
            (if rf
              (progn
                (if command-s
                  (command-s "_.PEDIT" pl "" "_R")
                  (vl-cmdf "_.PEDIT" pl "" "_R")
                )
                (while (< 0 (getvar (quote cmdactive)))
                  (vl-cmdf "")
                )
              )
            )
          )
        )
      )
      (prompt "\n(chiv) sub function works only on closed POLYLINE entity... Either you picked starting point of closed polyline, or you picked open polyline...")
    )
  )

  (if
    (and
      (not (prompt "\nPick closed POLYLINE on unlocked layer..."))
      (setq ss (ssget "_+.:E:S:L" '((0 . "*POLYLINE"))))
      (not (initget 1))
      (setq pt (getpoint "\nPick or specify point near vertex to become initial : "))
    )
    (chiv (ssname ss 0) pt)
  )
  (princ)
)

 

Marko Ribar, d.i.a. (graduated engineer of architecture)
Message 5 of 9

rpajounia
Advocate
Advocate

Please view attachment for sample file. So my drawing will start from the bottom left corner and will trace all the lines. I have a CNC machine which is suppose to cut the pattern and im trying to avoid polylines to avoid unnecessary back and forth on lines already cut if not necessary.  So pretty much what i need is a code that will output starting X and Starting Y points, Then it will say go to XY Point... Go to XY Point.... then going to XYPoint... Go to XY Point.... until all lines are traced... I was thinking of a code that makes a list of all the lines and then traces the first line from there use the distance function to see where is the closest line and just draw from there until its all drawn.

0 Likes
Message 6 of 9

Sea-Haven
Mentor
Mentor

I have no idea about your CNC machine but say laser cutter cut lines in color order may do what you want. Use Join command. It may for cyan lines need 4 "L" rather than single line.

 

There is I think some software around about changing draw order which hopefully equals cut order. That may be the way to go also.

0 Likes
Message 7 of 9

rpajounia
Advocate
Advocate

So with my machine it uses a feature that says go from this point to this point to this point im currently making the code for it but need a script that will help me with it. I need help with making the code that paths it for me so i can add the functions that writes it for my cnc machine to read it.

0 Likes
Message 8 of 9

hak_vz
Advisor
Advisor

According to your sample drawing here is my early working code.

You have to sequentially to pick points inside closed areas between polyllines you have (red ones) . Code creates bounding polyline and, sorts its points from lower left corner in CCW direction, and craters list pf its segments.

Segments are added to list of all segments. If segment or reverse direction segment is already in the list it is not included. To simplify the code you have to pick sequentially closed areas.

Before you start use command Breakselected from included file breackobjects.lsp to break all polylines to sub-segments   defined by touching polylines.

At the end segments stored in variable allsegs have to be written to exit file in desired format (to do).

 

 

 

(defun c:trace_lines_to_file ( / *error*)
	(defun *error* ( msg )
		(if (not (member msg '("Function cancelled" "quit / exit abort")))
			(princ)
		)
		(setvar 'cmdecho 1)
		(command "_.ucs" "w")
		(princ)
	)
	(defun take (amount lst / ret)(repeat amount (setq ret (cons (car lst) (take (1- amount) (cdr lst))))))
	(defun take2 (lst) (take 2 lst))
	(defun pointlist2d (lst / ret) (while lst (setq	ret (cons (take 2 lst) ret) lst (cddr lst))) (reverse ret))	(defun mappend (fn lst)(apply 'append (mapcar fn lst)))
	(setvar 'cmdecho 0)
	(setq osnap_mode (getvar "osmode"))
	(setq to_delete (ssadd) allsegs (list))
	(while 
		(and(setq pt (getpoint "\nPick point inside closed area >")))
		(command "_.bpoly" pt "" )
		(setq to_delete (ssadd (entlast)to_delete))
		(setq eo (vlax-ename->vla-object (entlast)))
		(vla-GetBoundingBox eo 'MinP 'MaxP)
		(setq pts (pointlist2d (vlax-get eo 'Coordinates)))
		(setq xc (/ (apply '+ (mapcar 'car pts)) (length pts)))
		(setq yc (/ (apply '+ (mapcar 'cadr pts)) (length pts)))
		(setq pc (list xc yc))
		(command "_.ucs" pc (vlax-safearray->list minp) "")
		(setq pts (vl-sort pts '(lambda (x y) (< (angle (trans pc 0 1) (trans x 0 1))(angle (trans pc 0 1) (trans y 0 1))))))
		(setq pts (append pts (list (car pts))))
		(command "_.ucs" "w")
		(setq segs (list) i -1)
		(while (< (setq i (1+ i)) (-(length pts)2))
			(setq segs (append segs (list(list (nth i pts)(nth (1+ i) pts)))))
		)
		(foreach seg segs
			(if 
				(not 
					(or 
						(member seg allsegs)
						(member (reverse seg) allsegs)
					)
				)
			(setq allsegs (append allsegs (list seg)))
			)
		)
	)
	(foreach seg allsegs (princ seg))
	(command "_erase" to_delete "" )
	(command "_.ucs" "w")
	(setvar 'cmdecho 1)
	(princ)
)

 

 

Miljenko Hatlak

EESignature

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.
0 Likes
Message 9 of 9

Sea-Haven
Mentor
Mentor

Reminds me of old pen plotters PD PU.

 

Why not google Gcode lisp it should be out there and do what you want, maybe free maybe a price.

0 Likes