[求助]关于圆弧的程序!!

ssljx

这代码不知道是那位版主写的,只有内切功能,把外切也能做出来吗?

(defun GetInterPoint (ent1 ent2 / ax_ent_1 ax_ent_2 intpoints points i)
(setq ax_ent_1 (vlax-ename->vla-object ent1)
ax_ent_2 (vlax-ename->vla-object ent2)
)
(setq intpoints (vla-intersectwith ax_ent_1 ax_ent_2 acextendnone))
(setq intpoints (vlax-variant-value intpoints))
(setq i 0)
(if (> (vlax-safearray-get-u-bound intpoints 1) 0)
(repeat (/ (+ 1
(- (vlax-safearray-get-u-bound intpoints 1)
(vlax-safearray-get-l-bound intpoints 1)
)
)
3
)
(setq points (append points (list (list
(vlax-safearray-get-element intpoints i)
(vlax-safearray-get-element intpoints (+ i 1))
(vlax-safearray-get-element intpoints (+ i 2))
)))
)
(setq i (+ 3 i))
)
)
points
)

(defun c:DAC ( / ent pt r entc entl pts i)
(setq ent (car (entsel "\n选择直线或圆弧...")))
(setq pt (getpoint "\n输入通过点:"))
(setq r (getreal "\n输入半径:"))
(setvar "cmdecho" 0)
(command "_.circle" pt r)
(setq entc (entlast))
(command "_.offset" r ent pt "")
(setq entl (entlast))
(setq pts (GetInterpoint entc entl))
(entdel entc)
(entdel entl)
(setq i 0)
(repeat (length pts)
(setq pt (nth i pts))
(command "_.circle" pt r)
(setq entc (entlast))
(if (= (length (GetInterpoint entc ent)) 0) (entdel entc))
(setq i (1+ i))
)
(princ)
)

Sayonana

不用这么复杂吧.LOOK

3. (defun c:test ()
4.   (if (and (setq ent (entsel "\nselect circle:"))
5.     (setq en (car ent))
6.     (setq pt (getpoint "\npick a point:"))
7.     (setq r (getreal "\ninput radius:"))
8.       )
9.     (progn
10.       (setq os (getvar "osmode"))
11.       (setvar "osmode" 0)
12.       (command ".undo" "be" ".line" (cdr (assoc 10 (entget en))) pt "")
13.       (setq en1 (entlast) obj-en1 (vlax-ename->vla-object en1))
14.       (command ".lengthen" "de" r (cdr (assoc 11 (entget en1))) "" ".circle" (cdr (assoc 11 (entget en1))) r)
15.       (command ".lengthen" "de" (- 0 r r) (cdr (assoc 11 (entget en1))) "" ".circle" (cdr (assoc 11 (entget en1))) r ".undo" "end")
16.       (entdel en1)
17.       (setvar "osmode" os)
18.     )
19.   )
20.   (princ)
21. )

(defun c:test ()   (if (and (setq ent (entsel "\nselect circle:"))     (setq en (car ent))     (setq pt (getpoint "\npick a point:"))     (setq r (getreal "\ninput radius:"))       )     (progn       (setq os (getvar "osmode"))       (setvar "osmode" 0)       (command ".undo" "be" ".line" (cdr (assoc 10 (entget en))) pt "")       (setq en1 (entlast) obj-en1 (vlax-ename->vla-object en1))       (command ".lengthen" "de" r (cdr (assoc 11 (entget en1))) "" ".circle" (cdr (assoc 11 (entget en1))) r)       (command ".lengthen" "de" (- 0 r r) (cdr (assoc 11 (entget en1))) "" ".circle" (cdr (assoc 11 (entget en1))) r ".undo" "end")       (entdel en1)       (setvar "osmode" os)     )   )   (princ) )

ssljx

谢谢楼上的回复,但你的程序我没法用,我的意思是过一点作圆弧跟直线.圆弧相切(包括外切,内外)

ssljx

没人能帮我吗?这里的版主呢??