Jump to content

Dear guys . Find the lisp and please help me .... following dwg file.

nest1291

By nest1291
in AutoLISP, Visual LISP & DCL

[[Template core/front/sharelinks/shareButton is throwing an error. This theme may be out of date. Run the support tool in the AdminCP to restore the default theme.]]

Recommended Posts

nest1291 Explorer

nest1291

Posted
  • Author
Posted

how can i change the title this thread?

rlx Grand Master

rlx

Posted
Posted
how can i change the title this thread?

 

 

don't think you can , probably must delete the tread and start a new. But I think certain members will see your question as a challenge and will respond (but I won't grrr-lee-bigal-tharwat-ronjonp-hanhphuc mention any names though)

BIGAL Grand Master

BIGAL

Posted
Posted (edited)

rlx very simple but needs two picks inside and outside this determines the circle direction. If you just use one pick then basicly there are 4 answers. For the "tee" use 1/2 circle again 2 picks.

 

Draw an arc offset 0.01 trim so this punches hole. Tested that and it worked so the two picks should work.

 

Left it at work its 90% done. Very easy just draw the arc use the two points of the angle rotate the arc or draw arc correct for quadrant. Use polygon at small offset inside arc, then TRIM "arc" "Fence" using points of polygon all done.

Edited by BIGAL
hanhphuc Mentor

hanhphuc

Posted
Posted

;express tool $0.02

getpoint

entmake circle

(c:extrim)

- one click trim inside

BIGAL Grand Master

BIGAL

Posted
Posted (edited)

Nice idea hanhphuc, left the almost finished at work uses a 3/4 arc as per dwg. This I roughed to check idea. Just need to get rotation correct.

 

Redid it

 

(defun c:ahtest1 ( / rad obj1 obj2 I x xy co-ordsxy oldsnap oldaunit oldangdir ang angr)

(setq oldsnap (getvar 'osmode))
(setq oldaunits (getvar 'aunits))
(setq oldangdir (getvar 'angdir))

(setvar 'aunits 3)
(setvar 'angdir 0)

(setq rad  (getreal "Enter radius" ))

(while (setq pt1 (getpoint "pick corner"))
(setq pt2 (getpoint pt1 "Pick outside"))
(setq ang (angle pt1 pt2))

(if (= (and (> ang 0.0)(<  ang(/ pi 2.0))) T)(setq angr 0.0))
(if (= (and (> ang (/ pi 2.0))(< ang pi)) T)(setq angr (/ pi 2.0)))
(if (= (and (> ang pi)(< ang (* pi 1.5)))T)(setq angr  pi ))
(if(=  (and (> ang (* pi 1.5))(< ang (* pi 2))) T)(setq angr (* pi 1.5)))

(setvar 'osmode 0)
(setq  co-ordsxy '())
(command "arc" "C" pt1 (polar pt1 (/ pi 2.0) rad) "a" (* 1.5 pi))
(command "rotate" "L" "" pt1 angr)
(setq obj1 (entlast))

(command "polygon" 25 pt1 "I" (* rad 0.9))
(setq obj2 (vlax-ename->vla-object (entlast)))
(setq co-ords (vlax-safearray->list (vlax-variant-value (vlax-get-property obj2 "Coordinates" ))))
(setq I 0)
(repeat (/(length co-ords) 2)
(setq xy (list (nth i co-ords)(nth (+ I 1) co-ords) ))
(setq co-ordsxy (cons xy co-ordsxy))
(setq I (+ I 2))
)
(vla-delete obj2)

(setq x 0)
(command "TRim" obj1 "" "f")
(repeat (length co-ordsxy)
(command (nth x co-ordsxy))
(setq x (+ x 1))
)
(command "" "")

(setvar 'osmode oldsnap)
)

(setvar 'aunits oldaunits)
(setvar 'angdir oldangdir)
(princ)
)

Edited by BIGAL
hanhphuc Mentor

hanhphuc

Posted
Posted (edited)

nice BIGAL drawing arc.

 

"TRIM" "arc" "Fence" using points of polygon all done.

Though not used to command call (too slow), just for fun.

(defun c:[color="red"]xtrim[/color] (/ s p [color="red"]i[/color] d e r)
 (setq	r (cond	(([color="red"]getreal[/color] "\nRadius : "))
	(500.)
	)
[color="red"]i (getvar 'cmdecho )[/color])
 (setvar 'cmdecho 0)
 (if ([color="red"]vl-catch-all-error-p[/color] (vl-catch-all-apply 'load '("extrim")))
   (princ [color="red"]"\nSorry! Express Tool failed?!"[/color])
   (while (and	r
	(setq p (getpoint "\nPick point: "))
	(vl-cmdf "_POLYGON" 4 "_non" p "C" r)
	(progn (setq e (entlast))(etrim e p)(entdel e)
	(entmakex (list '(0 . "CIRCLE") (cons 10 p) (cons 40 r)))
	 )
	(setq d (getpoint p "\nPick Side.. "))
	)
     (if (setq s (ssget "C" p d '((0 . "LWPOLYLINE"))))
(entdel (ssname s 0))
)
     (vl-cmdf "_TRIM" "" "F" "_non" p "_non" d "" "")
     )
   )
 [color="red"](setvar 'cmdecho i)[/color]
 (princ)
 )

Edited by hanhphuc
catch-apply , rename c:xtrim, cmdecho etc.. in red
Roy_043 Mentor

Roy_043

Posted
Posted

The provided dwg seems to be inaccurate. The OP asks for circles with a diameter of 1mm, and yet the arcs in the dwg have a radius of 787.931?

 

The code below will only work properly if there are no "*LINE" elements on the specified layer (lyr) within the search distance (dis) of the indicated center point.

(defun c:test ( / dis doc enmLast lyr pt ptCr1 ptCr2 rad)
 (setq doc (vla-get-activedocument (vlax-get-acad-object)))
 (vla-endundomark doc)
 (vla-startundomark doc)
 (setq dis 12000) ; Search distance.
 (setq rad 700)   ; Radius.
 (setq lyr "2")   ; Layer name.
 (setq pt (getpoint "\nCenter: "))
 (if
   (ssget
     "_C"
     (setq ptCr1 (mapcar '- pt (list (* 0.5 rad) (* 0.5 rad))))
     (setq ptCr2 (mapcar '+ pt (list (* 0.5 rad) (* 0.5 rad))))
     '((0 . "*LINE"))
   )
   (progn
     (setvar 'cmdecho 0)
     (command "_.circle" "_non" pt rad)
     (setq enmLast (entlast))
     (command "_.trim" enmLast "" "_crossing" "_non" ptCr1 "_non" ptCr2 "")
     (vl-some
       '(lambda (ang)
         (if (not (ssget "_F" (list pt (polar pt ang dis)) (list '(0 . "*LINE") (cons 8 lyr))))
           (progn
             (command "_.trim" "" (list enmLast (polar pt ang rad)) "")
             T
           )
         )
       )
       (list (* pi 0.25) (* pi 0.75) (* pi 1.25) (* pi 1.75))
     )
     (setvar 'cmdecho 1)
   )
 )
 (vla-endundomark doc)
 (princ)
)

nest1291 Explorer

nest1291

Posted
  • Author
Posted
The provided dwg seems to be inaccurate. The OP asks for circles with a diameter of 1mm, and yet the arcs in the dwg have a radius of 787.931?

 

The code below will only work properly if there are no "*LINE" elements on the specified layer (lyr) within the search distance (dis) of the indicated center point.

(defun c:test ( / dis doc enmLast lyr pt ptCr1 ptCr2 rad)
 (setq doc (vla-get-activedocument (vlax-get-acad-object)))
 (vla-endundomark doc)
 (vla-startundomark doc)
 (setq dis 12000) ; Search distance.
 (setq rad 700)   ; Radius.
 (setq lyr "2")   ; Layer name.
 (setq pt (getpoint "\nCenter: "))
 (if
   (ssget
     "_C"
     (setq ptCr1 (mapcar '- pt (list (* 0.5 rad) (* 0.5 rad))))
     (setq ptCr2 (mapcar '+ pt (list (* 0.5 rad) (* 0.5 rad))))
     '((0 . "*LINE"))
   )
   (progn
     (setvar 'cmdecho 0)
     (command "_.circle" "_non" pt rad)
     (setq enmLast (entlast))
     (command "_.trim" enmLast "" "_crossing" "_non" ptCr1 "_non" ptCr2 "")
     (vl-some
       '(lambda (ang)
         (if (not (ssget "_F" (list pt (polar pt ang dis)) (list '(0 . "*LINE") (cons 8 lyr))))
           (progn
             (command "_.trim" "" (list enmLast (polar pt ang rad)) "")
             T
           )
         )
       )
       (list (* pi 0.25) (* pi 0.75) (* pi 1.25) (* pi 1.75))
     )
     (setvar 'cmdecho 1)
   )
 )
 (vla-endundomark doc)
 (princ)
)

 

Thank you for your answer~. thank you.

 

yes. Diameter is now 1mm. .. that's example.

 

I must draw 1mm arc diameter . . I always draw repeatly.

 

so I need this lisp~. thank you.

 

and then.

 

Thank you for your test lisp. but It didn't work, I'm using autocad 2012. It can not work anything.

 

only display "center", and then any reply command line.

 

would you ckeck this test lisp ?.

 

Thank you~.

BIGAL Grand Master

BIGAL

Posted
Posted

Not user but 2012 may not have VL lisp hanhphuc has given me something I could not remember taking what I have just needs the VL stuff changed to entmake then it will work.

 

 

I ask for radius as the dwg did not make sense you can replace with rad set to 1.

 

 

Will try to find time maybe tomorrow to redo.

 

 

2 codes 1 for 3/4 arc another for 1/2 circle.

nest1291 Explorer

nest1291

Posted
  • Author
Posted
nice BIGAL drawing arc.

 

 

Though not used to command call (too slow), just for fun.

(defun c:[color="red"]xtrim[/color] (/ s p [color="red"]i[/color] d e r)
 (setq	r (cond	(([color="red"]getreal[/color] "\nRadius : "))
	(500.)
	)
[color="red"]i (getvar 'cmdecho )[/color])
 (setvar 'cmdecho 0)
 (if ([color="red"]vl-catch-all-error-p[/color] (vl-catch-all-apply 'load '("extrim")))
   (princ [color="red"]"\nSorry! Express Tool failed?!"[/color])
   (while (and	r
	(setq p (getpoint "\nPick point: "))
	(vl-cmdf "_POLYGON" 4 "_non" p "C" r)
	(progn (setq e (entlast))(etrim e p)(entdel e)
	(entmakex (list '(0 . "CIRCLE") (cons 10 p) (cons 40 r)))
	 )
	(setq d (getpoint p "\nPick Side.. "))
	)
     (if (setq s (ssget "C" p d '((0 . "LWPOLYLINE"))))
(entdel (ssname s 0))
)
     (vl-cmdf "_TRIM" "" "F" "_non" p "_non" d "" "")
     )
   )
 [color="red"](setvar 'cmdecho i)[/color]
 (princ)
 )

 

thank you for your response~!. thank you.

 

I like this lisp. It's pretty much what I need

 

.... thank you.

 

..and...

 

Can i draw arc "circle inside trim" open side automatically, Can't Circle judge automatically open side ?

nest1291 Explorer

nest1291

Posted
  • Author
Posted
;express tool $0.02

getpoint

entmake circle

(c:extrim)

- one click trim inside

 

thanks~ for your kindness~

nest1291 Explorer

nest1291

Posted
  • Author
Posted
Nice idea hanhphuc, left the almost finished at work uses a 3/4 arc as per dwg. This I roughed to check idea. Just need to get rotation correct.

 

Redid it

 

(defun c:ahtest1 ( / rad obj1 obj2 I x xy co-ordsxy oldsnap oldaunit oldangdir ang angr)

(setq oldsnap (getvar 'osmode))
(setq oldaunits (getvar 'aunits))
(setq oldangdir (getvar 'angdir))

(setvar 'aunits 3)
(setvar 'angdir 0)

(setq rad  (getreal "Enter radius" ))

(while (setq pt1 (getpoint "pick corner"))
(setq pt2 (getpoint pt1 "Pick outside"))
(setq ang (angle pt1 pt2))

(if (= (and (> ang 0.0)(<  ang(/ pi 2.0))) T)(setq angr 0.0))
(if (= (and (> ang (/ pi 2.0))(< ang pi)) T)(setq angr (/ pi 2.0)))
(if (= (and (> ang pi)(< ang (* pi 1.5)))T)(setq angr  pi ))
(if(=  (and (> ang (* pi 1.5))(< ang (* pi 2))) T)(setq angr (* pi 1.5)))

(setvar 'osmode 0)
(setq  co-ordsxy '())
(command "arc" "C" pt1 (polar pt1 (/ pi 2.0) rad) "a" (* 1.5 pi))
(command "rotate" "L" "" pt1 angr)
(setq obj1 (entlast))

(command "polygon" 25 pt1 "I" (* rad 0.9))
(setq obj2 (vlax-ename->vla-object (entlast)))
(setq co-ords (vlax-safearray->list (vlax-variant-value (vlax-get-property obj2 "Coordinates" ))))
(setq I 0)
(repeat (/(length co-ords) 2)
(setq xy (list (nth i co-ords)(nth (+ I 1) co-ords) ))
(setq co-ordsxy (cons xy co-ordsxy))
(setq I (+ I 2))
)
(vla-delete obj2)

(setq x 0)
(command "TRim" obj1 "" "f")
(repeat (length co-ordsxy)
(command (nth x co-ordsxy))
(setq x (+ x 1))
)
(command "" "")

(setvar 'osmode oldsnap)
)

(setvar 'aunits oldaunits)
(setvar 'angdir oldangdir)
(princ)
)

 

thanks~ for your kindness. ~

Roy_043 Mentor

Roy_043

Posted
Posted

@nest1291:

My code should work on your test dwg. Although you may need to add this at the top of the code:

(vl-load-com)

 

To make the code work for circles with a 1mm diameter you have to change these values:

(setq dis 12000) ; Search distance.
(setq rad 700)   ; Radius.
(setq lyr "2")   ; Layer name.

nest1291 Explorer

nest1291

Posted
  • Author
Posted
Nice idea hanhphuc, left the almost finished at work uses a 3/4 arc as per dwg. This I roughed to check idea. Just need to get rotation correct.

 

Redid it

 

(defun c:ahtest1 ( / rad obj1 obj2 I x xy co-ordsxy oldsnap oldaunit oldangdir ang angr)

(setq oldsnap (getvar 'osmode))
(setq oldaunits (getvar 'aunits))
(setq oldangdir (getvar 'angdir))

(setvar 'aunits 3)
(setvar 'angdir 0)

(setq rad  (getreal "Enter radius" ))

(while (setq pt1 (getpoint "pick corner"))
(setq pt2 (getpoint pt1 "Pick outside"))
(setq ang (angle pt1 pt2))

(if (= (and (> ang 0.0)(<  ang(/ pi 2.0))) T)(setq angr 0.0))
(if (= (and (> ang (/ pi 2.0))(< ang pi)) T)(setq angr (/ pi 2.0)))
(if (= (and (> ang pi)(< ang (* pi 1.5)))T)(setq angr  pi ))
(if(=  (and (> ang (* pi 1.5))(< ang (* pi 2))) T)(setq angr (* pi 1.5)))

(setvar 'osmode 0)
(setq  co-ordsxy '())
(command "arc" "C" pt1 (polar pt1 (/ pi 2.0) rad) "a" (* 1.5 pi))
(command "rotate" "L" "" pt1 angr)
(setq obj1 (entlast))

(command "polygon" 25 pt1 "I" (* rad 0.9))
(setq obj2 (vlax-ename->vla-object (entlast)))
(setq co-ords (vlax-safearray->list (vlax-variant-value (vlax-get-property obj2 "Coordinates" ))))
(setq I 0)
(repeat (/(length co-ords) 2)
(setq xy (list (nth i co-ords)(nth (+ I 1) co-ords) ))
(setq co-ordsxy (cons xy co-ordsxy))
(setq I (+ I 2))
)
(vla-delete obj2)

(setq x 0)
(command "TRim" obj1 "" "f")
(repeat (length co-ordsxy)
(command (nth x co-ordsxy))
(setq x (+ x 1))
)
(command "" "")

(setvar 'osmode oldsnap)
)

(setvar 'aunits oldaunits)
(setvar 'angdir oldangdir)
(princ)
)

 

thank you for your reponse~!!!!!!!!!!!

nest1291 Explorer

nest1291

Posted
  • Author
Posted
nice BIGAL drawing arc.

 

 

Though not used to command call (too slow), just for fun.

(defun c:[color="red"]xtrim[/color] (/ s p [color="red"]i[/color] d e r)
 (setq	r (cond	(([color="red"]getreal[/color] "\nRadius : "))
	(500.)
	)
[color="red"]i (getvar 'cmdecho )[/color])
 (setvar 'cmdecho 0)
 (if ([color="red"]vl-catch-all-error-p[/color] (vl-catch-all-apply 'load '("extrim")))
   (princ [color="red"]"\nSorry! Express Tool failed?!"[/color])
   (while (and	r
	(setq p (getpoint "\nPick point: "))
	(vl-cmdf "_POLYGON" 4 "_non" p "C" r)
	(progn (setq e (entlast))(etrim e p)(entdel e)
	(entmakex (list '(0 . "CIRCLE") (cons 10 p) (cons 40 r)))
	 )
	(setq d (getpoint p "\nPick Side.. "))
	)
     (if (setq s (ssget "C" p d '((0 . "LWPOLYLINE"))))
(entdel (ssname s 0))
)
     (vl-cmdf "_TRIM" "" "F" "_non" p "_non" d "" "")
     )
   )
 [color="red"](setvar 'cmdecho i)[/color]
 (princ)
 )

 

would you ckeck this lisp plz.

새 블33럭 (1).dwg

hanhphuc Mentor

hanhphuc

Posted
Posted
would you ckeck this lisp plz.

 

hi based on your post#1 there's no 45 deg in your drawing "1mm circle trim inside and open side.dwg‎"

since all lines are orthogonal, so 4 sides polygon is sufficient. 

 ([color="blue"]vl-cmdf[/color] "_POLYGON" [color="red"][b]4[/b][/color] "_non" p "C" r)

 

You can increase the polygon sides but it will cause more broken lines.

BTW have you tried Roy_043's post#8? Bricscad

nest1291 Explorer

nest1291

Posted
  • Author
Posted
hi based on your post#1 there's no 45 deg in your drawing "1mm circle trim inside and open side.dwg‎"

since all lines are orthogonal, so 4 sides polygon is sufficient. 

 ([color="blue"]vl-cmdf[/color] "_POLYGON" [color="red"][b]4[/b][/color] "_non" p "C" r)

 

You can increase the polygon sides but it will cause more broken lines.

BTW have you tried Roy_043's post#8? Bricscad

 

(vl-cmdf "_circle" p r "_non")

 

I changed code as like this . It correctly work. thank you very much..!!!!!!

 

thank very much.

hanhphuc Mentor

hanhphuc

Posted
Posted
(vl-cmdf "_circle" p r "_non")

 

I changed code as like this . It correctly work. thank you very much..!!!!!!

 

thank very much.

 

my old version 2007 does not support circle, glad you got it sorted.

Thank Express Tool, not me :)

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.

×
[[Template core/front/sharelinks/shareButton is throwing an error. This theme may be out of date. Run the support tool in the AdminCP to restore the default theme.]]
Go to topic listing
×
×
  • Create New...