Author Topic: Seek help:Don't make slug holes in the filleted or chamfered corner  (Read 2442 times)

0 Members and 1 Guest are viewing this topic.

2e4lite

• Guest
Seek help:Don't make slug holes in the filleted or chamfered corner
« on: February 01, 2014, 09:48:46 PM »
The following is the routine can draw slug holes in some polylines.The question now is what is drawn may occur error when the polyline is  filleted or chamfered .I hope it won't make slug holes in the filleted or chamfered corner . Who can help me to modify it .It will a great help to me.Thanks!

Code - Auto/Visual Lisp: [Select]
1.  (defun c:esc(/ TK1 TK2 KD A R SS N E IntersLineCircle gxl-Ax:2DPoint gxl-clock )
2. (defun IntersLineCircle ( p q c r / a d n s )
3.   (setq n (mapcar '- q p)
4.         p (trans p 0 n)
5.         c (trans c 0 n)
7.   )
8.   (cond
9.     ( (equal r (setq d (distance c a)))
10.       (list (trans a n 0))
11.     )
12.     ( (< d r)
13.       (setq s (sqrt (- (* r r) (* d d))))
14.       (list
15.         (trans (list (car p) (cadr p) (- (caddr c) s)) n 0)
16.         (trans (list (car p) (cadr p) (+ (caddr c) s)) n 0)
17.       )
18.     )
19.   )
20. )
21. (defun gxl-Ax:2DPoint (pt)
22.   (vlax-make-variant
23.       (vlax-make-safearray vlax-vbdouble '(0 . 1))
24.       (list (car pt) (cadr pt))
25.     )
26.   )
27. )
28. (defun gxl-clock  (PLIST / LW MINP MAXP LST)
29.   (cond   ((= 'LIST (type plist))
30.      (not
31.          (apply '+
32.           (lambda (a b)
33.             (- (* (car b) (cadr a)) (* (car a) (cadr b)))
34.           )
35.              )
36.              plist
37.              (cons (last plist) plist)
38.            )
39.          )
40.        )
41.      )
42.    )
43.    (t
44.     (if (= 'ename (type plist))
45.       (setq lw (vlax-ename->vla-object plist))
46.       (if (= 'VLA-OBJECT (type plist))
47.         (setq lw plist)
48.         )
49.       )
50.     (vla-GetBoundingBox lw 'MinP 'MaxP)
51.     (setq
52.       minp   (vlax-safearray->list minp)
53.       MaxP   (vlax-safearray->list MaxP)
54.       lst   (mapcar
55.           (lambda (x)
56.          lw
57.          )
58.             )
59.           )
60.         (list   minp
61.          (list (car MaxP) (cadr minp))
62.          MaxP
63.          (list (car minp) (cadr MaxP))
64.          )
65.         )
66.       )
67.     (if (or
72.           )
73.       t
74.       )
75.     )
76.    )
77.   )
78.
79.   (defun tk1 (E A      R      /      N      EL     I      P1     P2
80.                 P3     CLOCKWISEP    MIDANG CP     MRP    STP    ENP
81.                 MP     BULGE  ARCDATA       OBJ A1 A2
82.                 )
83.     (setq obj (vlax-ename->vla-object e))
84.     (vla-put-Closed obj :vlax-true)
85.     (setq n (fix (vlax-curve-getEndParam obj)))
86.     ;(if (/= 1 (logand (cdr (assoc 70 el)) 1)) (setq n (- n 2)))
87.     (setq i 0)
88.     (repeat n
89.       (setq p1 (vlax-curve-getPointAtParam e i)
90.             p2 (vlax-curve-getPointAtParam e (setq i (1+ i)))
91.             p3 (vlax-curve-getPointAtParam e (1+ i))
92.             )
93.       (if (null p3) (setq p3 (vlax-curve-getPointAtParam e 1)))
94.       (setq a1 (angle p2 p1)
95.             a2 (angle p2 p3)
96.             )
97.       (setq clockwisep
98.              (<
99.                (* (- (car p2) (car p1)) (- (cadr p3) (cadr p1)))
100.                (* (- (cadr p2) (cadr p1)) (- (car p3) (car p1)))
101.                )
102.             )
103.       (if (< a1 a2) (setq a1 (+ a1 pi pi)))
104.       (setq midang (* 0.5 (+ a1 a2)))
105.       (if clockwisep
106.         (setq cp (polar p2 midang (- a r))
107.               mrp (polar p2 midang a)
108.               )
109.         (setq cp (polar p2 midang (- r a))
110.               mrp (polar p2 midang (- a))
111.               )
112.         )
113.       (setq stp (car (vl-remove-if-not
114.                        '(lambda (x)
115.                           (equal (+ (distance p1 x) (distance p2 x))
116.                                  (distance p1 p2)
117.                                  1e-6
118.                                  )
119.                           )
120.                        (IntersLineCircle p2 p1 cp r)
121.                        )
122.                      )
123.             )
124.       (setq enp (car (vl-remove-if-not
125.                        '(lambda (x)
126.                           (equal (+ (distance p3 x) (distance p2 x))
127.                                  (distance p3 p2)
128.                                  1e-6
129.                                  )
130.                           )
131.                        (IntersLineCircle p2 p3 cp r)
132.                        )
133.                      )
134.             )
135.       (setq mp (mapcar '* '(0.5 0.5 0.5) (MAPCAR '+ stp enp)))
136.       (setq bulge (/ (distance mrp mp) (distance mp stp)))
137.       (if clockwisep (setq bulge (- bulge)))
138.       (setq arcdata (cons (list stp enp bulge) arcdata))
139.       )
140.     (setq  arcdata (reverse arcdata))
141.     (foreach data arcdata
142.       (setq stp (car data)
145.             )
146.                      obj
147.                      (vlax-curve-getclosestpointto obj enp)
148.                      )
149.                    )
150.             )
151.       (vla-put-coordinate obj n (GXL-AX:2DPOINT stp))
152.       (if (vlax-curve-getPointAtParam obj (1+ n))
153.       (vla-AddVertex obj (1+ n) (GXL-AX:2DPOINT enp))
154.         (vla-AddVertex obj 1 (GXL-AX:2DPOINT enp))
155.         )
156.       (vla-SetBulge obj n bulge)
157.       )
158.     )
159.
160.   (defun tk2 (E R CLOCK / OBJ POLYCLOCK I P1 P2 P3 ARCDATA PT BULGE FLAG
161.                 N)
162.     (setq obj (vlax-ename->vla-object e))
163.     (vla-put-Closed obj :vlax-true)
164.     (setq polyClock (not (gxl-clock e)))
165.     (setq i 0)
166.       (setq p1 (vlax-curve-getPointAtParam obj i)
167.             p2 (vlax-curve-getPointAtParam obj (setq i (1+ i)))
168.             p3 (vlax-curve-getPointAtParam obj (1+ i))
169.             )
170.       (if (null p3) (setq p3 (vlax-curve-getPointAtParam obj 1)))
171.       (cond
172.         (polyClock
173.          (cond
174.            (clock
175.
176.             (setq arcdata (cons (list (polar p2 (angle p2 p3) r) -1 nil) arcdata))
177.             )
178.            (t
179.             (setq arcdata (cons (list (polar p2 (angle p2 p1) r) -1 t) arcdata))
180.             )
181.            )
182.          )
183.         (t
184.          (cond
185.            (clock
186.             (setq arcdata (cons (list (polar p2 (angle p2 p1) r) 1 t) arcdata))
187.             )
188.            (t
189.             (setq arcdata (cons (list (polar p2 (angle p2 p3) r) 1 nil) arcdata))
190.             )
191.            )
192.          )
193.         )
194.       )
195.      (setq  arcdata (reverse arcdata))
196.     (foreach data arcdata
197.       (setq pt (car data)
200.             )
201.                      obj
202.                      (vlax-curve-getclosestpointto obj pt)
203.                      )
204.                    )
205.             )
206.       (if (vlax-curve-getPointAtParam obj (1+ n))
207.          (vla-AddVertex obj (1+ n) (GXL-AX:2DPOINT pt))
208.          (if flag
209.            (vla-SetBulge obj (1+ n) bulge)
210.            (vla-SetBulge obj n bulge)
211.            )
212.          )
213.          (vla-AddVertex obj 1 (GXL-AX:2DPOINT pt))
214.          (if flag
215.            (vla-SetBulge obj 1 bulge)
216.            (vla-SetBulge obj 0 bulge)
217.            )
218.          )
219.         )
220.       )
221.       )
222.   (initget "1 2 3")
223.   (if (null
224.         (setq kd (getkword "\n[standard(1)/Clockwise(2)/counterclockwise(3)]<1>"))
225.         )
226.     (setq kd "1")
227.     )
228.   (cond
229.     ((= "1" kd)
230.      (if (null (setq a (getreal "\nescape deep<0.1>:")))
231.        (setq a 0.1)
232.        )
233.      (if (null (setq r (getreal "\nescape Radius<0.4>:")))
234.        (setq r 0.4)
235.        )
236.      (while (setq ss (ssget '((0 . "lwpolyline"))))
237.        (repeat (setq n (sslength ss))
238.          (setq e (ssname ss (setq n (1- n))))
239.          (tk1 e a r)
240.          )
241.        )
242.      )
243.     (t
244.      (if (null (setq r (getreal "\nescape Radius<0.4>:")))
245.        (setq r 0.4)
246.        )
247.      (while (setq ss (ssget '((0 . "*polyline"))))
248.        (repeat (setq n (sslength ss))
249.          (setq e (ssname ss (setq n (1- n))))
250.          (tk2 e  r (= "2" kd))
251.          )
252.        )
253.      )
254.     )
255.   (princ)
256.   )
« Last Edit: February 01, 2014, 11:42:38 PM by CAB »

ymg

• Swamp Rat
• Posts: 725
Re: Seek help:Don't make slug holes in the filleted or chamfered corner
« Reply #1 on: February 02, 2014, 12:41:07 AM »
2e4elite,

What is a slug hole ?

Maybe post an example of what you are trying to achieve.

ymg

2e4lite

• Guest
Re: Seek help:Don't make slug holes in the filleted or chamfered corner
« Reply #2 on: February 02, 2014, 03:40:34 AM »
ymg,

The slug holes (also called Escape holes) . Attached Images will illustrate it better.

2e4elite

« Last Edit: February 02, 2014, 03:45:42 AM by 2e4lite »

ribarm

• Gator
• Posts: 2559
• Marko Ribar, architect
Re: Seek help:Don't make slug holes in the filleted or chamfered corner
« Reply #3 on: February 02, 2014, 04:02:29 AM »
How do you determine filleted or chamfered corner?... According to my tests the code won't error in any case of polylines, so what do you propose that ymg should do ab this; I just don't see any problem... Only thing you should consider is that curved arcs segments of polyline will be afterwards converted into straight segements with arcs at corners as should...

[EDIT note : Only thing I would suggest is cosmetic nature - better formatting and prompts specifications and also you had mistake at the end in (while) loops - I've added (while (not ss) (setq ss (ssget ...))) so that at the end of routine doesn't ask again for "Select Objects" as now does...]

Code: [Select]
`(defun c:esc (/          TK1        TK2        KD         A              R          SS         N          E              IntersLineCircle      gxl-Ax:2DPoint        gxl-clock             )  (vl-load-com)  (defun IntersLineCircle (p q c r / a d n s)    (setq n (mapcar '- q p)          p (trans p 0 n)          c (trans c 0 n)          a (list (car p) (cadr p) (caddr c))    )    (cond      ((equal r (setq d (distance c a)))       (list (trans a n 0))      )      ((< d r)       (setq s (sqrt (- (* r r) (* d d))))       (list         (trans (list (car p) (cadr p) (- (caddr c) s)) n 0)         (trans (list (car p) (cadr p) (+ (caddr c) s)) n 0)       )      )    )  )  (defun gxl-Ax:2DPoint (pt)    (vlax-make-variant      (vlax-safearray-fill        (vlax-make-safearray vlax-vbdouble '(0 . 1))        (list (car pt) (cadr pt))      )    )  )  (defun gxl-clock (PLIST / LW MINP MAXP LST)    (cond      ((= 'LIST (type plist))       (not         (minusp           (apply '+                  (mapcar                    (function                      (lambda (a b)                        (- (* (car b) (cadr a)) (* (car a) (cadr b)))                      )                    )                    plist                    (cons (last plist) plist)                  )           )         )       )      )      (t       (if (= 'ename (type plist))         (setq lw (vlax-ename->vla-object plist))         (if (= 'VLA-OBJECT (type plist))           (setq lw plist)         )       )       (vla-GetBoundingBox lw 'MinP 'MaxP)       (setq         minp (vlax-safearray->list minp)         MaxP (vlax-safearray->list MaxP)         lst  (mapcar                (function                  (lambda (x)                    (vlax-curve-getParamAtPoint                      lw                      (vlax-curve-getClosestPointTo lw x)                    )                  )                )                (list minp                      (list (car MaxP) (cadr minp))                      MaxP                      (list (car minp) (cadr MaxP))                )              )       )       (if (or             (<= (car lst) (cadr lst) (caddr lst) (cadddr lst))             (<= (cadr lst) (caddr lst) (cadddr lst) (car lst))             (<= (caddr lst) (cadddr lst) (car lst) (cadr lst))             (<= (cadddr lst) (car lst) (cadr lst) (caddr lst))           )         t       )      )    )  )  (defun tk1 (E     A     R     /     N     EL    I     P1    P2              P3    CLOCKWISEP  MIDANG      CP    MRP   STP   ENP              MP    BULGE ARCDATA     OBJ   A1    A2             )    (setq obj (vlax-ename->vla-object e))    (vla-put-Closed obj :vlax-true)    (setq n (fix (vlax-curve-getEndParam obj)))                                        ;(if (/= 1 (logand (cdr (assoc 70 el)) 1)) (setq n (- n 2)))    (setq i 0)    (repeat n      (setq p1 (vlax-curve-getPointAtParam e i)            p2 (vlax-curve-getPointAtParam e (setq i (1+ i)))            p3 (vlax-curve-getPointAtParam e (1+ i))      )      (if (null p3)        (setq p3 (vlax-curve-getPointAtParam e 1))      )      (setq a1 (angle p2 p1)            a2 (angle p2 p3)      )      (setq clockwisep             (<               (* (- (car p2) (car p1)) (- (cadr p3) (cadr p1)))               (* (- (cadr p2) (cadr p1)) (- (car p3) (car p1)))             )      )      (if (< a1 a2)        (setq a1 (+ a1 pi pi))      )      (setq midang (* 0.5 (+ a1 a2)))      (if clockwisep        (setq cp  (polar p2 midang (- a r))              mrp (polar p2 midang a)        )        (setq cp  (polar p2 midang (- r a))              mrp (polar p2 midang (- a))        )      )      (setq stp (car (vl-remove-if-not                       '(lambda (x)                          (equal (+ (distance p1 x) (distance p2 x))                                 (distance p1 p2)                                 1e-6                          )                        )                       (IntersLineCircle p2 p1 cp r)                     )                )      )      (setq enp (car (vl-remove-if-not                       '(lambda (x)                          (equal (+ (distance p3 x) (distance p2 x))                                 (distance p3 p2)                                 1e-6                          )                        )                       (IntersLineCircle p2 p3 cp r)                     )                )      )      (setq mp (mapcar '* '(0.5 0.5 0.5) (MAPCAR '+ stp enp)))      (setq bulge (/ (distance mrp mp) (distance mp stp)))      (if clockwisep        (setq bulge (- bulge))      )      (setq arcdata (cons (list stp enp bulge) arcdata))    )    (setq arcdata (reverse arcdata))    (foreach data arcdata      (setq stp   (car data)            enp   (cadr data)            bulge (caddr data)      )      (setq n (fix (vlax-curve-getParamAtPoint                     obj                     (vlax-curve-getclosestpointto obj enp)                   )              )      )      (vla-put-coordinate obj n (GXL-AX:2DPOINT stp))      (if (vlax-curve-getPointAtParam obj (1+ n))        (vla-AddVertex obj (1+ n) (GXL-AX:2DPOINT enp))        (vla-AddVertex obj 1 (GXL-AX:2DPOINT enp))      )      (vla-SetBulge obj n bulge)    )  )  (defun tk2 (E R CLOCK / OBJ POLYCLOCK I P1 P2 P3 ARCDATA PT BULGE FLAG              N)    (setq obj (vlax-ename->vla-object e))    (vla-put-Closed obj :vlax-true)    (setq polyClock (not (gxl-clock e)))    (setq i 0)    (repeat (fix (vlax-curve-getEndParam obj))      (setq p1 (vlax-curve-getPointAtParam obj i)            p2 (vlax-curve-getPointAtParam obj (setq i (1+ i)))            p3 (vlax-curve-getPointAtParam obj (1+ i))      )      (if (null p3)        (setq p3 (vlax-curve-getPointAtParam obj 1))      )      (cond        (polyClock         (cond           (clock            (setq              arcdata (cons (list (polar p2 (angle p2 p3) r) -1 nil)                            arcdata                      )            )           )           (t            (setq arcdata (cons (list (polar p2 (angle p2 p1) r) -1 t)                                arcdata                          )            )           )         )        )        (t         (cond           (clock            (setq arcdata (cons (list (polar p2 (angle p2 p1) r) 1 t)                                arcdata                          )            )           )           (t            (setq              arcdata (cons (list (polar p2 (angle p2 p3) r) 1 nil)                            arcdata                      )            )           )         )        )      )    )    (setq arcdata (reverse arcdata))    (foreach data arcdata      (setq pt    (car data)            bulge (cadr data)            flag  (caddr data)      )      (setq n (fix (vlax-curve-getParamAtPoint                     obj                     (vlax-curve-getclosestpointto obj pt)                   )              )      )      (if (vlax-curve-getPointAtParam obj (1+ n))        (progn          (vla-AddVertex obj (1+ n) (GXL-AX:2DPOINT pt))          (if flag            (vla-SetBulge obj (1+ n) bulge)            (vla-SetBulge obj n bulge)          )        )        (progn          (vla-AddVertex obj 1 (GXL-AX:2DPOINT pt))          (if flag            (vla-SetBulge obj 1 bulge)            (vla-SetBulge obj 0 bulge)          )        )      )    )  )  (initget "1 2 3")  (if (null        (setq kd (getkword                   "\n[Standard(1)/ClockWise(2)/CounterClockWise(3)] <1> : "                 )        )      )    (setq kd "1")  )  (cond    ((= "1" kd)     (if (null (setq a (getreal "\nEscape Deep <0.1> : ")))       (setq a 0.1)     )     (if (null (setq r (getreal "\nEscape Radius <0.4> : ")))       (setq r 0.4)     )     (while (not ss)       (setq ss (ssget '((0 . "LWPOLYLINE"))))       (repeat (setq n (sslength ss))         (setq e (ssname ss (setq n (1- n))))         (tk1 e a r)       )     )    )    (t     (if (null (setq r (getreal "\nEscape Radius <0.4> : ")))       (setq r 0.4)     )     (while (not ss)       (setq ss (ssget '((0 . "LWPOLYLINE"))))       (repeat (setq n (sslength ss))         (setq e (ssname ss (setq n (1- n))))         (tk2 e r (= "2" kd))       )     )    )  )  (princ))`
« Last Edit: February 02, 2014, 05:24:15 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

ymg

• Swamp Rat
• Posts: 725
Re: Seek help:Don't make slug holes in the filleted or chamfered corner
« Reply #4 on: February 02, 2014, 05:23:08 AM »
Marko,

As you said, the problem is you would need to define what is a fillet and/or chamfer.

The rest of the routine seems to do what it should.  It does seem strange though that arc
are converted to straight segments.

ymg

ribarm

• Gator
• Posts: 2559
• Marko Ribar, architect
Re: Seek help:Don't make slug holes in the filleted or chamfered corner
« Reply #5 on: February 02, 2014, 05:27:00 AM »
It does seem strange though that arc are converted to straight segments.

But that's double bulge specifications, that's why it's too difficult to realize it correctly...
Marko Ribar, d.i.a. (graduated engineer of architecture)

`;; Author:Gu_xl 2013.05.08;;update: 2014.01.06 (defun c:tt (/ TK1 TK2 KD A R SS N E)  ;;standard calculate  (defun tk1 (E A      R      /      N      EL     I      P1     P2                P3     CLOCKWISEP    MIDANG CP     MRP    STP    ENP                MP     BULGE  ARCDATA       OBJ A1 A2 k                )    (setq obj (vlax-ename->vla-object e))    (if (vlax-curve-isClosed obj)      (progn        (setq i 0)        (setq n (fix (vlax-curve-getEndParam obj)))        )      (progn        (setq i 0)        (setq n (1- (fix (vlax-curve-getEndParam obj)) ))        )      )    (repeat n      (setq p1 (vlax-curve-getPointAtParam e i)            p2 (vlax-curve-getPointAtParam e (setq i (1+ i)))            p3 (vlax-curve-getPointAtParam e (1+ i))            )      (if (and            (vlax-curve-isClosed obj)            (equal i (vlax-curve-getEndParam obj) 1e-6)            )        (setq k 0)        (setq k i)        )      (if (and            (equal 0 (vla-GetBulge obj (1- i)) 1e-6)            (equal 0 (vla-GetBulge obj k) 1e-6)            )        (progn      (if (null p3) (setq p3 (vlax-curve-getPointAtParam e 1)))      (setq a1 (angle p2 p1)            a2 (angle p2 p3)            )      (setq clockwisep             (<               (* (- (car p2) (car p1)) (- (cadr p3) (cadr p1)))               (* (- (cadr p2) (cadr p1)) (- (car p3) (car p1)))               )            )      (if (< a1 a2) (setq a1 (+ a1 pi pi)))      (setq midang (* 0.5 (+ a1 a2)))      (if clockwisep        (setq cp (polar p2 midang (- a r))              mrp (polar p2 midang a)              )        (setq cp (polar p2 midang (- r a))              mrp (polar p2 midang (- a))              )        )      (setq stp (car (vl-remove-if-not                       '(lambda (x)                          (equal (+ (distance p1 x) (distance p2 x))                                 (distance p1 p2)                                 1e-6                                 )                          )                       (IntersLineCircle p2 p1 cp r)                       )                     )            ) ;_ Arc start      (setq enp (car (vl-remove-if-not                       '(lambda (x)                          (equal (+ (distance p3 x) (distance p2 x))                                 (distance p3 p2)                                 1e-6                                 )                          )                       (IntersLineCircle p2 p3 cp r)                       )                     )            ) ;_ Arc end      (setq mp (mapcar '* '(0.5 0.5 0.5) (MAPCAR '+ stp enp)))      (setq bulge (/ (distance mrp mp) (distance mp stp))) ;_ Bowstring ratio      (if clockwisep (setq bulge (- bulge)))      (setq arcdata (cons (list stp enp bulge) arcdata))      )        )      )    (setq  arcdata (reverse arcdata))    (foreach data arcdata      (setq stp (car data)            enp (cadr data)            bulge (caddr data)            )      (setq n (fix (vlax-curve-getParamAtPoint                     obj                     (vlax-curve-getclosestpointto obj enp)                     )                   )            )      (vla-put-coordinate obj n (GXL-AX:2DPOINT stp))      (if (vlax-curve-getPointAtParam obj (1+ n))      (vla-AddVertex obj (1+ n) (GXL-AX:2DPOINT enp))        (vla-AddVertex obj 1 (GXL-AX:2DPOINT enp))        )      (vla-SetBulge obj n bulge)      )    )  ;;clockwise  (defun tk2 (E R CLOCK / OBJ POLYCLOCK I P1 P2 P3 ARCDATA PT BULGE FLAG                N k)    (setq obj (vlax-ename->vla-object e))    (setq polyClock (not (gxl-clock e)))    (setq i 0)    (if (vlax-curve-isClosed obj)      (progn        (setq i 0)        (setq n (fix (vlax-curve-getEndParam obj)))        )      (progn        (setq i 0)        (setq n (1- (fix (vlax-curve-getEndParam obj))))        )      )    (repeat n      (setq p1 (vlax-curve-getPointAtParam obj i)            p2 (vlax-curve-getPointAtParam obj (setq i (1+ i)))            p3 (vlax-curve-getPointAtParam obj (1+ i))            )      (if (and            (vlax-curve-isClosed obj)            (equal i (vlax-curve-getEndParam obj) 1e-6)            )        (setq k 0)        (setq k i)        )      (if (and            (equal 0 (vla-GetBulge obj (1- i)) 1e-6)            (equal 0 (vla-GetBulge obj k) 1e-6)            )        (progn      (if (null p3) (setq p3 (vlax-curve-getPointAtParam obj 1)))      (cond        (polyClock ;_ Curve clockwise         (cond           (clock ;_            (setq arcdata (cons (list (polar p2 (angle p2 p3) r) -1 nil) arcdata))            )           (t ;_             (setq arcdata (cons (list (polar p2 (angle p2 p1) r) -1 t) arcdata))            )           )         )        (t ;_ Curve counterclockwise         (cond           (clock ;_             (setq arcdata (cons (list (polar p2 (angle p2 p1) r) 1 t) arcdata))            )           (t ;_             (setq arcdata (cons (list (polar p2 (angle p2 p3) r) 1 nil) arcdata))            )           )         )        )      )    )      )     (setq  arcdata (reverse arcdata))    (foreach data arcdata      (setq pt (car data)            bulge (cadr data)            flag (caddr data)            )      (setq n (fix (vlax-curve-getParamAtPoint                     obj                     (vlax-curve-getclosestpointto obj pt)                     )                   )            )      (if (vlax-curve-getPointAtParam obj (1+ n))        (progn         (vla-AddVertex obj (1+ n) (GXL-AX:2DPOINT pt))         (if flag           (vla-SetBulge obj (1+ n) bulge)           (vla-SetBulge obj n bulge)           )         )        (progn         (vla-AddVertex obj 1 (GXL-AX:2DPOINT pt))         (if flag           (vla-SetBulge obj 1 bulge)           (vla-SetBulge obj 0 bulge)           )         )        )      )      )  (initget "1 2 3")  (if (null        (setq kd (getkword "\n[standard(1)/clockwise(2)/counterclockwise(3)]<1>"))        )    (setq kd "1")    )  (cond    ((= "1" kd)     (if (null (setq a (getreal "\nMagnitude<5.0>:")))       (setq a 5.0)       )     (if (null (setq r (getreal "\nAperture radius<10.0>:")))       (setq r 10.0)       )     (while (setq ss (ssget '((0 . "lwpolyline"))))       (repeat (setq n (sslength ss))         (setq e (ssname ss (setq n (1- n))))         (tk1 e a r) ;_ trim         )       )     )    (t     (if (null (setq r (getreal "\nAperture radius<10.0>:")))       (setq r 10.0)       )     (while (setq ss (ssget '((0 . "*polyline"))))       (repeat (setq n (sslength ss))         (setq e (ssname ss (setq n (1- n))))         (tk2 e  r (= "2" kd)) ;_ trim         )       )     )    )  (princ)  );;*******************A custom function****************************;; Line-Circle Intersection - Lee Mac(defun IntersLineCircle ( p q c r / a d n s )  (setq n (mapcar '- q p)        p (trans p 0 n)        c (trans c 0 n)        a (list (car p) (cadr p) (caddr c))  )  (cond    ( (equal r (setq d (distance c a)))      (list (trans a n 0))    )    ( (< d r)      (setq s (sqrt (- (* r r) (* d d))))      (list        (trans (list (car p) (cadr p) (- (caddr c) s)) n 0)        (trans (list (car p) (cadr p) (+ (caddr c) s)) n 0)      )    )  ));;(defun gxl-Ax:2DPoint (pt)  (vlax-make-variant    (vlax-safearray-fill      (vlax-make-safearray vlax-vbdouble '(0 . 1))      (list (car pt) (cadr pt))    )  ));;(defun gxl-clock  (PLIST / LW MINP MAXP LST)  (cond        ((= 'LIST (type plist))          (not            (minusp              (apply '+                     (mapcar                       (function                         (lambda (a b)                           (- (* (car b) (cadr a)) (* (car a) (cadr b)))                         )                       )                       plist                       (cons (last plist) plist)                     )              )            )          )        )        (t         (if (= 'ename (type plist))           (setq lw (vlax-ename->vla-object plist))           (if (= 'VLA-OBJECT (type plist))             (setq lw plist)             )           )         (vla-GetBoundingBox lw 'MinP 'MaxP)         (setq           minp        (vlax-safearray->list minp)           MaxP        (vlax-safearray->list MaxP)           lst        (mapcar                  (function                    (lambda (x)                      (vlax-curve-getParamAtPoint                        lw                        (vlax-curve-getClosestPointTo lw x)                        )                       )                     )                   (list        minp                        (list (car MaxP) (cadr minp))                        MaxP                        (list (car minp) (cadr MaxP))                        )                   )            )          (if (or               (<= (car lst) (cadr lst) (caddr lst) (cadddr lst))               (<= (cadr lst) (caddr lst) (cadddr lst) (car lst))               (<= (caddr lst) (cadddr lst) (car lst) (cadr lst))               (<= (cadddr lst) (car lst) (cadr lst) (caddr lst))               )            t           )          )        )  )`