Inside circle trim routine LISP

[Anonymous]

Hi LISP Expert,

I need a LISP that can find all circles and trim everything inside it.

Currently, I do it manually and took hours to trim line inside the circles ( Approx 2000 Circles) 

Perhaps someone can help me with this matter;

Thanks

[Anonymous]

(defun c:trimincircle ()
(vl-load-com)

(defun *error* (msg)
	(setvar "osmode" old-os)
	(princ msg)
	(princ)
);defun error

(setq old-os (getvar "osmode"))
(setvar "osmode" 0)

(setq sset (ssget (list (cons 0 "CIRCLE"))))
(setq n 0)

(repeat (sslength sset)
(setq obj (ssname sset n))
(setq obj1 (vlax-ename->vla-object obj))
(setq cen (vlax-safearray->list (vlax-variant-value (vla-get-center obj1))))
(setq rad (vla-get-radius obj1))
(setq p 0)

(defun DTR (ang)
	(* PI (/ ang 180.0))
);defun DTR

(setq ang 0)

(repeat 360
	(setq p1 cen)
	(setq p2 (polar p1 (DTR ang) rad))
	(command "trim" obj "" "f" p1 p2 "" "")
	(setq ang (1+ ang))
);repeat


(repeat 360
	(setq p1 cen)
	(setq p2 (polar p1 (DTR ang) (- rad (* 0.1 rad))))
	(command "erase" "f" p1 p2 "" "")
	(setq ang (1+ ang))
);repeat

(setq n (1+ n))
);repeat



(princ)
(*error*)

);defun

It may help you.

STM

[ВeekeeCZ]

Why not to make the fence selection all around and use the TRIM command just once. It could be much faster.

[Anonymous]

Yeah, it's working but it takes time to complete the task. 

10 circles in within a minute which is still acceptable.  

[Anonymous]

How to do it? any tutorial link for this.

Thanks BeekeeCZ

[Anonymous]

Why not to make the fence selection all around and use the TRIM command just once. It could be much faster

-------------------------------------------------------------------------------------------------------------------------------------------------

Thanks for your suggestion.

How to do this master?. I don't know how to do this. Please guide.

STM

[Anonymous]

I run the LISP but it didn't work with 700 or more number of Circles 

[Anonymous]

can u attach the drawing?

[ВeekeeCZ]

Sure, nothing complicated. The simplest way is directly use the counted points.

(command "_.trim" obj "" "_f" p1) ; keep the trim command running...

(repeat 360
  (setq p2 (polar...))
  (command p2)) ; fill up with middle points

(command p1 "" "") ; the last point would be the same as the first; finish the command to perform

But since you need to use the same list of points twice, it would be better to build the list first.

(setq lst (list p1))
(repeat 360
  (setq p2 (polar...))
  (setq lst (cons p2 lst)))
(setq lst (cons p1 lst))

(command "_.trim" obj "" "_f")
(foreach p lst
  (command p))
(command "" "")

[ВeekeeCZ]

Well, I see... the second list would not be the same, but it does not hurt the try different approach as well. 🙂

PS. Consider temporarily zooming to the object (little more) before performing the selection...

[Anonymous]

Thank you @ВeekeeCZ

[Anonymous]

can u attach the drawing?

----------------------------------------------------

Here is the drawing with 832 circles to trim line inside it.

[stevor]

The polygon solution trims along straight edges.

The possible error can be made small, as by the 360 steps.

Arcs can trim to the resolution of the autocad math.

[Anonymous · Accepted solution]

The lisp can't trim more than 100 circle.

[ahsattarian3]

Why not using Extrim Lisp ?

U can find it here :

(defun c:etn ()
(defun etn-average ()
(if (= typ "POLYLINE")
(command "convertpoly" "light" s "")
)
(setq en (entget s))
(setq xt 0)
(setq yt 0)
(setq q 0)
(foreach a en
(if (= (car a) 10)
(progn
(setq q (1+ q))
(setq xt (+ xt (nth 1 a)))
(setq yt (+ yt (nth 2 a)))
)
)
)
(setq xm (/ xt q))
(setq ym (/ yt q))
(setq zm (cdr (assoc 38 en)))
(setq na s)
(setq p1 (list xm ym zm))
)
(defun etrim (na a / la b d e1 lst lst2
n j k m ss na2 na3 na4 x
y z flag flag2 flag3 zlst vpna vplocked
)
(setq e1 (entget na))
(if (or (setq flag (equal (acet-dxf 0 e1) "POLYLINE"))
(setq flag (equal (acet-dxf 0 e1) "LWPOLYLINE"))
(equal (acet-dxf 0 e1) "LINE")
(equal (acet-dxf 0 e1) "CIRCLE")
(equal (acet-dxf 0 e1) "ARC")
(equal (acet-dxf 0 e1) "ELLIPSE")
(equal (acet-dxf 0 e1) "TEXT")
(equal (acet-dxf 0 e1) "ATTDEF")
(equal (acet-dxf 0 e1) "MTEXT")
(equal (acet-dxf 0 e1) "SPLINE")
)
(progn
(if (and flag
(equal 8 (logand 8 (acet-dxf 70 e1)))
)
(setq flag nil)
)
(setq a (trans a 1 0)
vpna (acet-currentviewport-ename)
)
(acet-ucs-cmd (list "_View"))
(setq lst (acet-geom-object-point-list na nil)
lst (acet-geom-list-extents lst)
x (- (car (cadr lst)) (car (car lst)))
y (- (cadr (cadr lst)) (cadr (car lst)))
x (* 0.075 x)
y (* 0.075 y)
z (list x y)
x (list (+ (car (cadr lst)) (car z))
(+ (cadr (cadr lst)) (cadr z))
)
y (list (- (car (car lst)) (car z))
(- (cadr (car lst)) (cadr z))
)
zlst (zoom_2_object (list x y))
)
(if vpna
(setq vplocked (acet-viewport-lock-set vpna nil))
)
(command "_.zoom" "_w" (car zlst) (cadr zlst))
(entupd na)
(setq lst (acet-geom-object-point-list
na
(/ (acet-geom-pixel-unit) 2.0)
)
)
(if (or (not flag)
(not (acet-geom-self-intersect lst nil))
)
(progn
(if (and flag
(equal (car lst) (last lst) 0.0001)
)
(setq flag3 t)
)
(if (setq la (acet-layer-locked (getvar "clayer")))
(command "_.layer" "_unl" (getvar "clayer") "")
)
(command "_.pline")
(setq b nil)
(setq n 0)
(repeat (length lst)
(setq d (nth n lst))
(if (not (equal d b 0.0001))
(progn
(command d)
(setq lst2 (append lst2 (list d)))
(setq b d)
)
)
(setq n (+ n 1))
)
(command "")
(setq na2 (entlast)
ss (ssadd)
ss (ssadd na2 ss)
lst nil
)
(acet-ss-visible ss 1)
(setq lst2 (get_fence_points na2 a lst2 flag3 flag))
(if la
(command "_.layer" "_lock" (getvar "clayer") "")
)
(acet-ucs-cmd (list "_p"))
(setvar "highlight" 0)
(if (setq ss (ssget "_f" (last lst2)))
(command "_.move" ss "" "0,0,0" "0,0,0")
)
(if flag
(progn
(if (setq la (acet-layer-locked (acet-dxf 8 e1)))
(command "_.layer" "_unl" (acet-dxf 8 e1) "")
)
(acet-ucs-set-z (acet-dxf 210 e1))
(command "_.copy" na "" "0,0,0" "0,0,0")
(acet-ss-visible (ssadd na (ssadd)) 1)
(setq na3 na
na (entlast)
)
(command "_.pedit" na "_w" "0.0" "_x")
(acet-ucs-cmd (list "_p"))
(if la
(command "_.layer" "_lock" (acet-dxf 8 e1) "")
)
)
)
(command "_.trim" na "")
(setq m (- (length lst2) 1))
(setq k 0)
(repeat (length lst2)
(setq lst (nth k lst2))
(setq a (trans (car lst) 0 1))
(setq n 1)
(repeat (- (length lst) 1)
(setq b (trans (nth n lst) 0 1))
(if (equal a b 0.0001)
(setq flag2 t)
(setq flag2 nil)
)
(setq na4 nil)
(setq j 0)
(while (not flag2)
(setq na4 (entlast))
(command "_F" a b "")
(if (and (equal na4 (entlast))
(or (not (equal k m))
(> j 0)
)
)
(setq flag2 t)
)
(setq j (+ j 1))
)
(setq a b)
(setq n (+ n 1))
)
(setq k (+ k 1))
)
(command "")
(if flag
(progn
(if (setq la (acet-layer-locked (acet-dxf 8 e1)))
(command "_.layer" "_unl" (acet-dxf 8 e1) "")
)
(entdel na)
(acet-ss-visible (ssadd na3 (ssadd)) 0)
(if la
(command "_.layer" "_lock" (acet-dxf 8 e1) "")
)
)
)
)
(progn
(acet-ucs-cmd (list "_p"))
(princ "\nSelf intersecting edges are not acceptable.")
)
)
(command "_.zoom" "_p")
(if vplocked
(acet-viewport-lock-set vpna t)
)
)
)
)
(setq flt '((-4 . "<OR")
(0 . "CIRCLE")
(0 . "ARC")
(0 . "ELLIPSE")
(0 . "LWPOLYLINE")
(0 . "POLYLINE")
(-4 . "OR>")
)
)
(setq ss (ssget flt))
(setq nn (sslength ss))
(setq kk -1)
(repeat nn
(setq kk (1+ kk))
(setq s (ssname ss kk))
(setq en (entget s))
(setq typ (cdr (assoc 0 en)))
(if (or (= typ "LWPOLYLINE") (= typ "POLYLINE"))
(progn
(etn-average)
)
)
(if (or (= typ "CIRCLE") (= typ "ARC") (= typ "ELLIPSE"))
(progn
(setq na s)
(setq p1 (cdr (assoc 10 en)))
)
)
(etrim na p1)
)
)

[ahsattarian3]

Extrim Numeral + Layer(s)     ETL

(defun c:etl ()
(defun etn-average ()
(if (= typ "POLYLINE")
(command "convertpoly" "light" s "")
)
(setq en (entget s))
(setq xt 0)
(setq yt 0)
(setq q 0)
(foreach a en
(if (= (car a) 10)
(progn
(setq q (1+ q))
(setq xt (+ xt (nth 1 a)))
(setq yt (+ yt (nth 2 a)))
)
)
)
(setq xm (/ xt q))
(setq ym (/ yt q))
(setq zm (cdr (assoc 38 en)))
(setq na s)
(setq p1 (list xm ym zm))
)
(defun etrim (na a / la b d e1 lst lst2 n j k m ss na2 na3 na4 x y z flag flag2 flag3 zlst vpna vplocked)
(setq e1 (entget na))
(if (or (setq flag (equal (acet-dxf 0 e1) "POLYLINE"))
(setq flag (equal (acet-dxf 0 e1) "LWPOLYLINE"))
(equal (acet-dxf 0 e1) "LINE")
(equal (acet-dxf 0 e1) "CIRCLE")
(equal (acet-dxf 0 e1) "ARC")
(equal (acet-dxf 0 e1) "ELLIPSE")
(equal (acet-dxf 0 e1) "TEXT")
(equal (acet-dxf 0 e1) "ATTDEF")
(equal (acet-dxf 0 e1) "MTEXT")
(equal (acet-dxf 0 e1) "SPLINE")
)
(progn
(if (and flag
(equal 8 (logand 8 (acet-dxf 70 e1)))
)
(setq flag nil)
)
(setq a (trans a 1 0)
vpna (acet-currentviewport-ename)
)
(acet-ucs-cmd (list "_View"))
(setq lst (acet-geom-object-point-list na nil)
lst (acet-geom-list-extents lst)
x (- (car (cadr lst)) (car (car lst)))
y (- (cadr (cadr lst)) (cadr (car lst)))
x (* 0.075 x)
y (* 0.075 y)
z (list x y)
x (list (+ (car (cadr lst)) (car z))
(+ (cadr (cadr lst)) (cadr z))
)
y (list (- (car (car lst)) (car z))
(- (cadr (car lst)) (cadr z))
)
zlst (zoom_2_object (list x y))
)
(if vpna
(setq vplocked (acet-viewport-lock-set vpna nil))
)
(command "_.zoom" "_w" (car zlst) (cadr zlst))
(entupd na)
(setq lst (acet-geom-object-point-list
na
(/ (acet-geom-pixel-unit) 2.0)
)
)
(if (or (not flag)
(not (acet-geom-self-intersect lst nil))
)
(progn
(if (and flag
(equal (car lst) (last lst) 0.0001)
)
(setq flag3 t)
)
(if (setq la (acet-layer-locked (getvar "clayer")))
(command "_.layer" "_unl" (getvar "clayer") "")
)
(command "_.pline")
(setq b nil)
(setq n 0)
(repeat (length lst)
(setq d (nth n lst))
(if (not (equal d b 0.0001))
(progn
(command d)
(setq lst2 (append lst2 (list d)))
(setq b d)
)
)
(setq n (+ n 1))
)
(command "")
(setq na2 (entlast)
ss (ssadd)
ss (ssadd na2 ss)
lst nil
)
(acet-ss-visible ss 1)
(setq lst2 (get_fence_points na2 a lst2 flag3 flag))
(if la
(command "_.layer" "_lock" (getvar "clayer") "")
)
(acet-ucs-cmd (list "_p"))
(setvar "highlight" 0)
(if (setq ss (ssget "_f" (last lst2)))
(command "_.move" ss "" "0,0,0" "0,0,0")
)
(if flag
(progn
(if (setq la (acet-layer-locked (acet-dxf 8 e1)))
(command "_.layer" "_unl" (acet-dxf 8 e1) "")
)
(acet-ucs-set-z (acet-dxf 210 e1))
(command "_.copy" na "" "0,0,0" "0,0,0")
(acet-ss-visible (ssadd na (ssadd)) 1)
(setq na3 na
na (entlast)
)
(command "_.pedit" na "_w" "0.0" "_x")
(acet-ucs-cmd (list "_p"))
(if la
(command "_.layer" "_lock" (acet-dxf 8 e1) "")
)
)
)
(command "_.trim" na "")
(setq m (- (length lst2) 1))
(setq k 0)
(repeat (length lst2)
(setq lst (nth k lst2))
(setq a (trans (car lst) 0 1))
(setq n 1)
(repeat (- (length lst) 1)
(setq b (trans (nth n lst) 0 1))
(if (equal a b 0.0001)
(setq flag2 t)
(setq flag2 nil)
)
(setq na4 nil)
(setq j 0)
(while (not flag2)
(setq na4 (entlast))
(command "_F" a b "")
(if (and (equal na4 (entlast))
(or (not (equal k m))
(> j 0)
)
)
(setq flag2 t)
)
(setq j (+ j 1))
)
(setq a b)
(setq n (+ n 1))
)
(setq k (+ k 1))
)
(command "")
(if flag
(progn
(if (setq la (acet-layer-locked (acet-dxf 8 e1)))
(command "_.layer" "_unl" (acet-dxf 8 e1) "")
)
(entdel na)
(acet-ss-visible (ssadd na3 (ssadd)) 0)
(if la
(command "_.layer" "_lock" (acet-dxf 8 e1) "")
)
)
)
)
(progn
(acet-ucs-cmd (list "_p"))
(princ "\nSelf intersecting edges are not acceptable.")
)
)
(command "_.zoom" "_p")
(if vplocked
(acet-viewport-lock-set vpna t)
)
)
)
)
(princ "\n Select Layers : ")
(setq li-And-Begin (list (cons -4 "<AND")))
(setq li-And-End (list (cons -4 "AND>")))
(setq li-Or-Begin (list (cons -4 "<OR")))
(setq li-Or-End (list (cons -4 "OR>")))
(setq layerlist nil)
(setq filter1 nil)
(setq ss (ssget))
(setq n (sslength ss))
(setq k -1)
(setq asoc 8)
(repeat n
(setq k (1+ k))
(setq s (ssname ss k))
(setq en (entget s))
(setq lay (cdr (assoc asoc en)))
(if (not (member lay layerlist))
(progn
(setq layerlist (append layerlist (list lay)))
(setq filter1 (append filter1 (list (cons asoc lay))))
)
)
)
(print layerlist)
(setq filter1 (append li-Or-Begin filter1 li-Or-End))
(setq filter2 (list (cons -4 "<OR")
(cons 0 "CIRCLE")
(cons 0 "ARC")
(cons 0 "ELLIPSE")
(cons 0 "LWPOLYLINE")
(cons 0 "POLYLINE")
(cons -4 "OR>")
)
)
(setq filtering (append li-And-Begin filter1 filter2 li-And-End))
(setq ss (ssget filtering))
(setq nn (sslength ss))
(setq kk -1)
(setvar "cmdecho" 0)
(repeat nn
(setq kk (1+ kk))
;;(print (strcat "\n Doing : " (itoa (1+ kk)) " of " (itoa nn)))
(setq s (ssname ss kk))
(setq en (entget s))
(setq typ (cdr (assoc 0 en)))
(if (or (= typ "LWPOLYLINE") (= typ "POLYLINE"))
(progn
(etn-average)
)
)
(if (or (= typ "CIRCLE") (= typ "ARC") (= typ "ELLIPSE"))
(progn
(setq na s)
(setq p1 (cdr (assoc 10 en)))
)
)
(etrim na p1)
)
)

[zph]

aryzz,

I see your drawing and it looks as if all the green lines are vertical.  Have you considered erasing all the lines then connecting all the circles together with ONLY vertical lines that ONLY start and end at the top and bottom quadrants of the circles?

Perhaps, order the circles by coordinate X and Y locations (using vl-sort) to establish the order of line creation and eliminate duplicates/overlapping.

Just an idea.

~Z

EDIT:  you could also get an initial selection set of the green lines, do a proximity selection method to gather nearby red circles, find the intersections and modify the line's endpoints to match the red circle's quadrants.

[Anonymous]

Sir excellent program.

Can you please modify this in order to trim all objects outside 2 circles. I am new to lisp.

I need to trim all obejcts that fall outside of gear major dia and inside of gear minor dia. In short whatever is within the 2 circles must be retained everything else must be trimmed.

Thanks a lot!!

[george566a]

Did you get help? I am encoutering same propblem thats why i am  here. If you did kindly share the lisp file