[求助]这个LISP程序如何编写？

r0r

meflying发表于2003-10-24 13:28:001、做按钮，你看帮助文件，有详细介绍，本论坛也有很多的讨论了，
2、选择？根据什么条件选择呢？因为这些圆都满足已知条件，我不能无端将谁去掉

以纯使用者的角度说：
   1. 点此命令后应先确定通过的点，再选相切的线段；比如过圆外一点与此圆相切，条件成立的话最少二个圆，作图时总知道切点方位，你就点那个部位，不就只能生成一个圆了吗。
   2.点相切的线段时，光标接触的线段最好能变成虚线，以正确选择
   3.从没做过按钮，能提个头吗？（要编程免说了，对此0.1点都不懂）

meflying

你如果不想自学，那最好参加一些培训，这里不可能一点一点地教你，这里是解决你在学习过程中遇到的问题，是解决问题，而不是教学。
按钮是菜单，你看相应的帮助，我说了很多次了，帮助中有详细的介绍，你怎么就不去看？

r0r

meflying发表于2003-10-24 14:16:00你如果不想自学，那最好参加一些培训，这里不可能一点一点地教你，这里是解决你在学习过程中遇到的问题，是解决问题，而不是教学。
按钮是菜单，你看相应的帮助，我说了很多次了，帮助中有详

关键是这二点！
以纯使用者的角度说：
   1. 点此命令后应[I]先确定通过的点，再选相切的线段[/I]；比如过圆外一点与此圆相切，条件成立的话最少二个圆，作图时总知道切点方位，你就点那个部位（此时如果[U]虚线显示生成的圆[/U]更好了），不就只能生成一个圆了吗。
   2.点相切的线段时，[U]光标接触的线段最好能变成虚线[/U]，以正确选择

我E文绝对不好，只认识字母，不认识单字，我何尝不想自己搞定呢！奈何先天不足，心有余而力不足，有时真的请见谅！

meflying

你的已知条件不够，无法完成

r0r

这是我在其它CAD软件中相关功能的操作步骤：以过圆外一点与此圆相切为例
1.点“切”按钮
2.选“点”，再选圆上任意点，在二点间生成一条虚线
3.选内切还是外切
4.光标移向虚线，待光标变形后按住鼠标左键并拖动，虚线变成一个动态的相切圆，你可即时拉动、观察，并弹出一个小窗口，即时显示半径的大小，松开鼠标左键，你可在小窗口中填写要求的半径大小，点确定
5.完成
是否可以从这个例子中说明问题？

ljpnb

meflying发表于2003-10-23 8:27:00哦，是这样，你必须先加载(vl-load-com)，将这句放到程序的最前面，因为我的系统会自行加载这个，所以我每次都不记得这句，再试试

谢谢,加了(vl-load-com)后程序是可以出来结果,不过有一点,如果捕捉功能开着的时候,程序会出错，如果在选择“输入通过点”之后，关掉捕捉功能，那么可以画出最终的那个圆，不过它还会叫你画一个圆！不知道为什么？

龙龙仔

即时拉动、观察

(defun C:TEST1 (/ QQ QQ1 ENT1 PT)
  (setvar "osmode" 0)
  (setq QQ (getpoint "选点: "))
  (setvar "osmode" 256)
  (setq QQ1 (getpoint QQ "选切点: "))
  (setvar "osmode" 0)
  (setq ENT1 (entlast))
  (while (= (car (setq PT (grread 2 4))) 5)
    (if        (not (equal (entlast) ENT1))
      (entdel (entlast))
    )
    (command "_.circle" "3p" QQ "tan" QQ1 (cadr PT))
  )
  (princ)
)

r0r

龙龙仔发表于2003-10-24 16:56:00即时拉动、观察

(defun C:TEST1 (/ QQ QQ1 ENT1 PT)
   (setvar "osmode" 0)
   (setq QQ (getpoint "选点: "))
   (setvar "osmode" 256)
   (setq QQ

龙龙仔版主：与meflying程序结合，参照35楼的方法，能给个完整的程序吗？

BDYCAD

嘩!!!
這個最棒.  好程序..想不到可以如此改進..



-------------------------------------------------
我愛CAD     多多學習.  多多指教.

meflying

r0r发表于2003-10-24 15:47:00这是我在其它CAD软件中相关功能的操作步骤：以过圆外一点与此圆相切为例
1.点“切”按钮
2.选“点”，再选圆上任意点，在二点间生成一条虚线
3.选内切还是外切
4.光标移向虚线，待光标

你说话怎么不一次说完？到现在才把具体要求说出来，弹出窗口同时可移动鼠标画图不是VLISP能做到的，
你这样的提问会让人累死的，希望你在提问是能够注意一下方法，论坛留言里有篇帖子，关于提问的，应该好好读读。（注：你应该考虑到不是每个人每个软件都会用过，所以不是所有的过程大家都会明白的）
下面这个，你凑合用吧

2. (defun sscat(ss1 ss2 / i ename)
   
3.   (setq i 0)
   
4.   (cond
   
5.     ((not ss1) ss2)
   
6.     ((not ss2) ss1)
   
7.     (t
   
8.      (while (< i (sslength ss2))
   
9.        (setq ename (ssname ss2 i))
   
10.        (ssadd ename ss1)
    
11.        (setq i (1+ i))
    
12.      )
    
13.      ss1)
    
14.   )
    
15. )
    
16. 
    
17. (defun ssredraw (ss n / i)
    
18.   (setq i 0)
    
19.   (repeat (sslength ss)
    
20.     (redraw (ssname ss i) n)
    
21.     (setq i (1+ i))
    
22.   )
    
23. )
    
24. 
    
25. (defun GetClosedEnt(ss pt / i sname dist ents)
    
26.   (setq i 0)
    
27.   (repeat (sslength ss)
    
28.     (setq sname (ssname ss i))
    
29.     (setq dist (distance pt (cdr (assoc 10 (entget sname)))))
    
30.     (setq ents (append ents (list (list dist sname))))
    
31.     (setq i (1+ i))
    
32.   )
    
33.   (setq ents (vl-sort ents '(lambda (e1 e2) (< (car e1) (car e2)))))
    
34.   (cadar ents)
    
35. )
    
36. (defun GetInterPoint (ent1 ent2 / ax_ent_1 ax_ent_2 intpoints points i)
    
37.   (setq ax_ent_1 (vlax-ename->vla-object ent1)
    
38.         ax_ent_2 (vlax-ename->vla-object ent2)
    
39.   )
    
40.   (setq intpoints (vla-intersectwith ax_ent_1 ax_ent_2 acextendnone))
    
41.   (setq intpoints (vlax-variant-value intpoints))
    
42.   (setq i 0)
    
43.   (if (> (vlax-safearray-get-u-bound intpoints 1) 0)
    
44.     (repeat (/ (+ 1
    
45.               (- (vlax-safearray-get-u-bound intpoints 1)
    
46.                  (vlax-safearray-get-l-bound intpoints 1)
    
47.               )
    
48.            )
    
49.            3
    
50.         )
    
51.       (setq points (append points (list (list
    
52.         (vlax-safearray-get-element intpoints i)
    
53.         (vlax-safearray-get-element intpoints (+ i 1))
    
54.         (vlax-safearray-get-element intpoints (+ i 2))
    
55.       )))
    
56.       )
    
57.       (setq i (+ 3 i))
    
58.     )
    
59.   )
    
60.   points
    
61. )
    
62. (defun Draw(pts r ent / pt entc i)
    
63.   (setq i 0)
    
64.   (setq entss (ssadd))
    
65.   (repeat (length pts)
    
66.     (setq pt (nth i pts))
    
67.     (command "_.circle" pt r)
    
68.     (setq entc (entlast))
    
69.     (ssadd entc entss)
    
70.     (if (= (length (GetInterpoint entc ent)) 0) (entdel entc))
    
71.     (setq i (1+ i))
    
72.   )
    
73.   entss
    
74. )
    
75. 
    
76. (defun c:DrawCircle( / ent pt r entc entl pts rArc ptArc entss)
    
77.   (setq ent (car (entsel "\n选择直线或圆弧...")))
    
78.   (setq rArc (cdr (assoc 40 (entget ent))))
    
79.   (setq ptArc (cdr (assoc 10 (entget ent))))
    
80.   (setq pt (getpoint "\n输入通过点:"))
    
81.   (setq r (getreal "\n输入半径:"))
    
82.   (if (and (< (distance pt ptArc) rArc) (> r rArc)) (exit))
    
83.   (setvar "cmdecho" 0)
    
84.   (command "_.circle" pt r)
    
85.   (setq entc (entlast))
    
86.   (command "_.offset" r ent pt "")
    
87.   (setq entl (entlast))
    
88.   (if (not (equal entc entl))
    
89.     (progn
    
90.       (setq pts (GetInterpoint entc entl))
    
91.       (entdel entl)
    
92.       (setq entss (Draw pts r ent))
    
93.     )
    
94.   )
    
95.   (if (> r rArc)
    
96.     (progn
    
97.       (command "_.circle" ptArc (- r rArc))
    
98.       (setq entl (entlast))
    
99.       (setq pts (GetInterpoint entc entl))
    
100.       (setq entss (sscat entss (Draw pts r ent)))
     
101.       (entdel entl)
     
102.     )
     
103.   )
     
104.   (entdel entc)
     
105.   (while (= (car (setq pt (grread 2 5))) 5)
     
106.     (ssredraw entss 3)
     
107.     (redraw (setq entc (GetClosedEnt entss (cadr pt))) 4)
     
108.   )
     
109.   (ssdel entc entss)
     
110.   (command "_.erase" entss "")
     
111.   (princ)
     
112. )
     
113. 
     

(defun sscat(ss1 ss2 / i ename)<br />   (setq i 0)<br />   (cond<br />     ((not ss1) ss2)<br />     ((not ss2) ss1)<br />     (t<br />      (while (< i (sslength ss2))<br />        (setq ename (ssname ss2 i))<br />        (ssadd ename ss1)<br />        (setq i (1+ i))<br />      )<br />      ss1)<br />   )<br /> )<br /> <br /> (defun ssredraw (ss n / i)<br />   (setq i 0)<br />   (repeat (sslength ss)<br />     (redraw (ssname ss i) n)<br />     (setq i (1+ i))<br />   )<br /> )<br /> <br /> (defun GetClosedEnt(ss pt / i sname dist ents)<br />   (setq i 0)<br />   (repeat (sslength ss)<br />     (setq sname (ssname ss i))<br />     (setq dist (distance pt (cdr (assoc 10 (entget sname)))))<br />     (setq ents (append ents (list (list dist sname))))<br />     (setq i (1+ i))<br />   )<br />   (setq ents (vl-sort ents '(lambda (e1 e2) (< (car e1) (car e2)))))<br />   (cadar ents)<br /> )<br /> (defun GetInterPoint (ent1 ent2 / ax_ent_1 ax_ent_2 intpoints points i)<br />   (setq ax_ent_1 (vlax-ename->vla-object ent1)<br />         ax_ent_2 (vlax-ename->vla-object ent2)<br />   )<br />   (setq intpoints (vla-intersectwith ax_ent_1 ax_ent_2 acextendnone))<br />   (setq intpoints (vlax-variant-value intpoints))<br />   (setq i 0)<br />   (if (> (vlax-safearray-get-u-bound intpoints 1) 0)<br />     (repeat (/ (+ 1<br />               (- (vlax-safearray-get-u-bound intpoints 1)<br />                  (vlax-safearray-get-l-bound intpoints 1)<br />               )<br />            )<br />            3<br />         )<br />       (setq points (append points (list (list<br />         (vlax-safearray-get-element intpoints i)<br />         (vlax-safearray-get-element intpoints (+ i 1))<br />         (vlax-safearray-get-element intpoints (+ i 2))<br />       )))<br />       )<br />       (setq i (+ 3 i))<br />     )<br />   )<br />   points<br /> )<br /> (defun Draw(pts r ent / pt entc i)<br />   (setq i 0)<br />   (setq entss (ssadd))<br />   (repeat (length pts)<br />     (setq pt (nth i pts))<br />     (command "_.circle" pt r)<br />     (setq entc (entlast))<br />     (ssadd entc entss)<br />     (if (= (length (GetInterpoint entc ent)) 0) (entdel entc))<br />     (setq i (1+ i))<br />   )<br />   entss<br /> )<br /> <br /> (defun c:DrawCircle( / ent pt r entc entl pts rArc ptArc entss)<br />   (setq ent (car (entsel "\n选择直线或圆弧...")))<br />   (setq rArc (cdr (assoc 40 (entget ent))))<br />   (setq ptArc (cdr (assoc 10 (entget ent))))<br />   (setq pt (getpoint "\n输入通过点:"))<br />   (setq r (getreal "\n输入半径:"))<br />   (if (and (< (distance pt ptArc) rArc) (> r rArc)) (exit))<br />   (setvar "cmdecho" 0)<br />   (command "_.circle" pt r)<br />   (setq entc (entlast))<br />   (command "_.offset" r ent pt "")<br />   (setq entl (entlast))<br />   (if (not (equal entc entl))<br />     (progn<br />       (setq pts (GetInterpoint entc entl))<br />       (entdel entl)<br />       (setq entss (Draw pts r ent))<br />     )<br />   )<br />   (if (> r rArc)<br />     (progn<br />       (command "_.circle" ptArc (- r rArc))<br />       (setq entl (entlast))<br />       (setq pts (GetInterpoint entc entl))<br />       (setq entss (sscat entss (Draw pts r ent)))<br />       (entdel entl)<br />     )<br />   )<br />   (entdel entc)<br />   (while (= (car (setq pt (grread 2 5))) 5)<br />     (ssredraw entss 3)<br />     (redraw (setq entc (GetClosedEnt entss (cadr pt))) 4)<br />   )<br />   (ssdel entc entss)<br />   (command "_.erase" entss "")<br />   (princ)<br /> )<br /> <br />