topic Re: Auto trim in circle in Visual LISP, AutoLISP and General Customization Forum

Auto trim in circle

Avan7garde — Mon, 29 May 2017 12:59:19 GMT

Hello, I have lisp that trim one line in circle, Can someone change lisp, so when I press with node (ask size of circle) and automatic all line in circle to trim, not only one. I try but didnt successful.

(defun C:at ()
(C:BreakAtMidPoint)
)

(defun C:BreakAtMidPoint (/ entItem lstPoint sngDistance)
(if (setq sngDistance (getdist "\nEnter Break Length: "))
(while (and
(vl-cmdf "circle" "End" pause)
(vl-cmdf (/ sngDistance 2.0))
(setq entItem (entlast))
(setq lstPoint (getvar "lastpoint"))
)
(vl-cmdf "trim" entItem "" "Nea" lstPoint "")
(vl-cmdf "erase" entItem "")
(setq entItem nil)
)
)
)
(vl-load-com)

Re: Auto trim in circle

_Tharwat — Mon, 29 May 2017 15:54:55 GMT

Hi,

You can use the command extrim if you have the Express Tools installed along with your AutoCAD.

Re: Auto trim in circle

Anonymous — Tue, 30 May 2017 03:55:05 GMT

(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

Re: Auto trim in circle

Avan7garde — Tue, 30 May 2017 05:04:16 GMT

the second one is good, but can you add my command in your so when I use command automatic enter the size of circle and in that circle trim all lines?

Re: Auto trim in circle

Avan7garde — Tue, 30 May 2017 13:01:02 GMT

my lisp is good but it only trim one line, and the polyline trim both side, and circle disappear, I need that but for all lines or poly lines disappear with one click, when I click on middle it ask what dimension to create circle, 0.5 and it create circle trim one line and circle disappear, so with one click to disappear all inside, i try to mix those two lisp but it not good.

Re: Auto trim in circle

Anonymous — Wed, 31 May 2017 04:41:26 GMT

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

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

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


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


(setq a 0)

(while a
(progn

(setq dst (getdist "\n Enter Break distance:"))
(setq p1 (getpoint "\n Pick the point:"))

(command "circle" p1 dst)
(setq obj (entlast))


(setq ang 0)



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

(setq ang 0)

(repeat 360
	
	(setq p2 (polar p1 (DTR ang) (- dst (* 0.05 dst))))
	(command "erase" "f" p1 p2 "" "")
	(setq ang (1+ ang))
);repeat

(command "erase" obj "")

);progn
);while


(princ)
(*error*)

);defun

It may help you

STM

Re: Auto trim in circle

Avan7garde — Wed, 31 May 2017 05:04:51 GMT

this is good, but can you just change from to pick the point to node, cos all my point is node

I found the better one for my job and faster, but tnx anyway

;....................  Spajanje tocaka sa razmakom ....................... 
(defun C:LIN()
    (setvar "CMDECHO" 0)
    (if (= mj nil) (setq mj 1000))
    (setq mjr mj)
    (princ "Mjerilo <1:") 
    (princ mjr)
    (setq mj (getint "> ")) 
    (if (= mj nil) (setq mj mjr))

    (if (= raz nil) (setq raz 1.3))
    (princ "\nRazmak crta-tocka (mm) <")
    (princ raz) 
    (setq razx (getreal ">"))
    (if (/= razx nil) (setq raz razx))
    (setq hg (* (/ (float mj) 1000.0) raz))

    (setq w (ssget))
    (setq n (sslength w))
    (setq n1 0) 

    (repeat n       
        (setq e (entget (ssname w n1)))
        (if (= "LINE" (cdr (assoc 0 e)))
           (progn    
	     (setq koo1 (assoc 10 e))
	     (setq koo2 (assoc 11 e))

	     (setq y (nth 1 koo1))
	     (setq x (nth 2 koo1))
             (setq p1 (list y x 0.0))
      
	     (setq y (nth 1 koo2))
	     (setq x (nth 2 koo2))
             (setq p2 (list y x 0.0))

             (setq d (distance p1 p2))
             (setq a (angle p1 p2))
             (setq t1 (polar p1 a raz))
             (setq t2 (polar p1 a (- d raz)))

		 (setq hs (assoc 10 e))
                 (setq hn (cons 10 t1))  
		 (setq e (subst hn hs e))

		 (setq hs (assoc 11 e))
                 (setq hn (cons 11 t2))  
		 (setq e (subst hn hs e))

                 (entmod e)        
	   )
	)
        (setq n1 (+ n1 1))    
    )
)