[求助]怎么写一个画三心拱的程序？

maozhumao

记得以前在哪看到过一个帖子，发了源代码 ，哪位大侠有，给小弟一个？

maozhumao@163.com

dcj_gis2006

1. (defun C:SanXinGong()
   
2.   (setvar "cmdecho" 0)
   
3.   (setq pa (getpoint "\n 指定基点:"))
   
4.   (setq ww (getdist pa "\n 净宽<100>:"))
   
5.   (if (null ww) (setq ww 100.0))
   
6.   (setq pb (polar pa 0 ww))
   
7.   (command "line" pa pb "")
   
8.   (setq pf (polar pa 0 (/ ww 2)))
   
9.   (setq hh (getdist pf "\n 净高<30>:"))
   
10.   (if (null hh) (setq hh 30.0))
    
11.   (setq pc (polar pf (/ pi 2) hh))
    
12.   (command "line" pa pc "")
    
13.   (setq cfo (polar pc (* pi 1.5) (* ww 2)))
    
14.   (command "line" pc cfo "")
    
15.   
    
16.   (setq pd (list (car pa) (cadr pc)))
    
17.   (command "line" pa pd "")
    
18.   (command "line" pc pd "")
    
19.   
    
20.   (setq dis_ac (sqrt (+ (* hh hh) (* (/ ww 2) (/ ww 2)))))
    
21.   (setq ang_dac (atan (/ (/ ww 2) hh)))
    
22.   (setq ang_dca (atan (/ hh (/ ww 2))))
    
23.   (setq ang_eac (/ ang_dac 2))
    
24.   (setq ang_eca (/ ang_dca 2))
    
25.   (setq pae (polar pa (+ ang_eac (atan (/ hh (/ ww 2)))) dis_ac))
    
26.   (setq pce (polar pc (+ ang_eca pi) dis_ac))
    
27.   (setq pe (inters pa pae pc pce))
    
28.   (command "line" pa pae "")
    
29.   (command "line" pc pce "")
    
30.   
    
31.   (setq eo1 (polar pe (- (* pi 2) (atan (/ (/ ww 2) hh))) ww))
    
32.   (command "line" pe eo1 "")
    
33.   
    
34.   (setq o2 (inters pa pb pe eo1))
    
35.   (setq o1 (inters pe eo1 pc cfo))
    
36.   
    
37.   (command "arc" pc "E" pe o1)
    
38.   (setq en1 (entlast))
    
39.   (command "arc" pe "E" pa o2)
    
40.   (setq en2 (entlast))
    
41.   (command "mirror" en1 "" pc pf "N")
    
42.   (command "mirror" en2 "" pc pf "N")
    
43.   (prin1)
    
44.   )

(defun C:SanXinGong()<br />   (setvar "cmdecho" 0)<br />   (setq pa (getpoint "\n 指定基点:"))<br />   (setq ww (getdist pa "\n 净宽<100>:"))<br />   (if (null ww) (setq ww 100.0))<br />   (setq pb (polar pa 0 ww))<br />   (command "line" pa pb "")<br />   (setq pf (polar pa 0 (/ ww 2)))<br />   (setq hh (getdist pf "\n 净高<30>:"))<br />   (if (null hh) (setq hh 30.0))<br />   (setq pc (polar pf (/ pi 2) hh))<br />   (command "line" pa pc "")<br />   (setq cfo (polar pc (* pi 1.5) (* ww 2)))<br />   (command "line" pc cfo "")<br />   <br />   (setq pd (list (car pa) (cadr pc)))<br />   (command "line" pa pd "")<br />   (command "line" pc pd "")<br />   <br />   (setq dis_ac (sqrt (+ (* hh hh) (* (/ ww 2) (/ ww 2)))))<br />   (setq ang_dac (atan (/ (/ ww 2) hh)))<br />   (setq ang_dca (atan (/ hh (/ ww 2))))<br />   (setq ang_eac (/ ang_dac 2))<br />   (setq ang_eca (/ ang_dca 2))<br />   (setq pae (polar pa (+ ang_eac (atan (/ hh (/ ww 2)))) dis_ac))<br />   (setq pce (polar pc (+ ang_eca pi) dis_ac))<br />   (setq pe (inters pa pae pc pce))<br />   (command "line" pa pae "")<br />   (command "line" pc pce "")<br />   <br />   (setq eo1 (polar pe (- (* pi 2) (atan (/ (/ ww 2) hh))) ww))<br />   (command "line" pe eo1 "")<br />   <br />   (setq o2 (inters pa pb pe eo1))<br />   (setq o1 (inters pe eo1 pc cfo))<br />   <br />   (command "arc" pc "E" pe o1)<br />   (setq en1 (entlast))<br />   (command "arc" pe "E" pa o2)<br />   (setq en2 (entlast))<br />   (command "mirror" en1 "" pc pf "N")<br />   (command "mirror" en2 "" pc pf "N")<br />   (prin1)<br />   )

命令: sanxingong
指定基点:
净宽<100>:
净高<30>:

shift逸

好程序，分享了，谢谢