处女作，本人开发第一个程序，明经第一时间低调发布

邹锋

来明经学LISP已快有两个月，还是谢谢各位大侠帮忙，，，
以下为小弟写的小软件，，呵呵，不足之处望改进（小弟才学一两个月，肯定很多不懂的，，给点意见吧）

2. ;;;本程序由用户自定义参数快速绘制模具行位三视图
   
3. ;;; by tony 20111125
   
4. ;;;CAD使用命令：XXX
   
5. ;;;
   
6. (alert "欢迎使用本程序，若要更多相关程序，请联系QQ：609719845")
   
7. (defun c:xxx()
   
8.    (setvar "cmdecho" 0)
   
9.    (setvar "osmode" 0)
   
10.    (dcl_xxx)
    
11.    (prin1)
    
12. )
    
13. (defun dcl_xxx()
    
14.    (setq dcl_id (load_dialog "xxx"))
    
15.    (new_dialog "xxx" dcl_id)   
    
16.    (def_xxx)
    
17.    (action_tile "kimage1" "(setq ddtype 1)")
    
18.    (action_tile "accept" "(ok_xxx)(done_dialog 1)")
    
19.    (setq dd(start_dialog))
    
20.    (if (= dd 1)
    
21.        (draw_xxx)
    
22.    )
    
23. )
    
24. (defun def_xxx()
    
25.    (set_tile "aa1" "15")
    
26.    (set_tile "aa2" "5")
    
27.    (set_tile "ww1" "53")
    
28.    (set_tile "ww2" "43")
    
29.    (set_tile "hh1" "38")
    
30.    (set_tile "hh2" "23")
    
31.    (set_tile "hh3" "6")
    
32.    (set_tile "ll1" "45")
    
33.    (set_tile "ll2" "30")
    
34.    (setq sldkey_list '("kimage1"))
    
35.    (setq sld_list    '("xxx"))
    
36.    (mapcar 'show_sld sldkey_list sld_list)
    
37. )
    
38. 
    
39. (defun show_sld(key sld)
    
40.    (setq x (dimx_tile key))
    
41.    (setq y (dimy_tile key))
    
42.    (start_image key)
    
43.    (fill_image 0 0 x y -2)
    
44.    (slide_image 0 0 x y sld)
    
45.    (end_image)
    
46. )
    
47. (defun ok_xxx()
    
48.    (setq WW1 (atof (get_tile "ww1")))
    
49.    (setq WW2 (atof (get_tile "ww2")))
    
50.    (setq HH1 (atof (get_tile "hh1")))
    
51.    (setq HH2 (atof (get_tile "hh2")))
    
52.    (setq HH3 (atof (get_tile "hh3")))
    
53.    (setq AA1 (atof (get_tile "aa1")))
    
54.    (setq AA2 (atof (get_tile "aa2")))
    
55.    (setq LL1 (atof (get_tile "ll1")))
    
56.    (setq LL2 (atof (get_tile "ll2")))
    
57. )
    
58. (defun draw_xxx()
    
59.   ;;以下绘制最上面的侧视图 以左下角点为基准
    
60.    (setq pt1 (getpoint "左下角基准点:"))
    
61.    (setq pt2 (polar pt1 0 LL1))
    
62.    (setq pt3 (polar pt2 (* pi 0.5) (- hh1 hh2)))
    
63.    (setq pt4 (polar pt3 0 LL2))
    
64.    (setq pt5 (polar pt4 (* pi 0.5) HH2))
    
65.    (setq bb (* (/ (sin (* AA1 (/ pi 180))) (cos (* aa1 (/ pi 180)))) (- hh1 hh3)))
    
66.    (setq pt6 (polar pt5 pi (- (+ LL1 LL2) bb)))
    
67.    (SETQ pt7 (polar pt1 (* pi 0.5) HH3))
    
68.    (command "pline" pt1 pt2 pt3 pt4 pt5 pt6 PT7 "C")
    
69.   ;;以下绘制右边的俯视图以基点下来30mm
    
70.   (setq pa (polar pt1 (* pi 1.5) 30))
    
71.   (setq pb (polar pa 0 ll1))
    
72.   (setq pc (polar pb (* pi 1.5) (/ (- ww1 ww2) 2)))
    
73.   (setq cc (/ ll2 (cos (* pi (/ aa2 180.0)))))
    
74.   (setq ee (sqrt (- (* cc cc) (* ll2 ll2))))
    
75.   (setq pd (polar pc (* pi (- 0 (/ AA2 180))) cc));;;这一行好像不太对,但行的通
    
76.   (setq pe (polar pd (* pi 1.5) (- ww2 (* ee 2))))
    
77.   (setq pf (polar pc (* pi 1.5) ww2))
    
78.   (setq pg (polar pb (* pi 1.5) ww1))
    
79.   (setq ph (polar pa (* pi 1.5) ww1))
    
80.   (command "pline" pa pb pc pd pe pf pg ph "c")
    
81.   ;;;以下绘制左边的侧视图
    
82.   (setq ea (polar pa pi 30))
    
83.   (setq eb (polar ea pi hh3))
    
84.   (setq ec (polar eb (* pi 1.5) (/ (- ww1 ww2) 2)))
    
85.   (setq ed (polar ec pi (- hh1 hh3)))
    
86.   (setq ef (polar ed (* pi 1.5) ww2))
    
87.   (setq eg (polar ef 0 (- hh1 hh3)))
    
88.   (setq eh (polar eg (* pi 1.5) (/ (- ww1 ww2) 2)))
    
89.   (setq ej (polar ea (* pi 1.5) ww1))
    
90.   (command "pline" ea eb ec ed ef eg eh ej "c")
    
91.   (setvar "osmode" 1)
    
92. (prin1)
    
93. (prompt "\n      行位已绘制完毕，如有更好建议，请联系QQ609719845")
    
94. (PRIN1)
    
95.   )

;;;本程序由用户自定义参数快速绘制模具行位三视图<br /> ;;; by tony 20111125<br /> ;;;CAD使用命令：XXX<br /> ;;;<br /> (alert "欢迎使用本程序，若要更多相关程序，请联系QQ：609719845")<br /> (defun c:xxx()<br />    (setvar "cmdecho" 0)<br />    (setvar "osmode" 0)<br />    (dcl_xxx)<br />    (prin1)<br /> )<br /> (defun dcl_xxx()<br />    (setq dcl_id (load_dialog "xxx"))<br />    (new_dialog "xxx" dcl_id)   <br />    (def_xxx)<br />    (action_tile "kimage1" "(setq ddtype 1)")<br />    (action_tile "accept" "(ok_xxx)(done_dialog 1)")<br />    (setq dd(start_dialog))<br />    (if (= dd 1)<br />        (draw_xxx)<br />    )<br /> )<br /> (defun def_xxx()<br />    (set_tile "aa1" "15")<br />    (set_tile "aa2" "5")<br />    (set_tile "ww1" "53")<br />    (set_tile "ww2" "43")<br />    (set_tile "hh1" "38")<br />    (set_tile "hh2" "23")<br />    (set_tile "hh3" "6")<br />    (set_tile "ll1" "45")<br />    (set_tile "ll2" "30")<br />    (setq sldkey_list '("kimage1"))<br />    (setq sld_list    '("xxx"))<br />    (mapcar 'show_sld sldkey_list sld_list)<br /> )<br /> <br /> (defun show_sld(key sld)<br />    (setq x (dimx_tile key))<br />    (setq y (dimy_tile key))<br />    (start_image key)<br />    (fill_image 0 0 x y -2)<br />    (slide_image 0 0 x y sld)<br />    (end_image)<br /> )<br /> (defun ok_xxx()<br />    (setq WW1 (atof (get_tile "ww1")))<br />    (setq WW2 (atof (get_tile "ww2")))<br />    (setq HH1 (atof (get_tile "hh1")))<br />    (setq HH2 (atof (get_tile "hh2")))<br />    (setq HH3 (atof (get_tile "hh3")))<br />    (setq AA1 (atof (get_tile "aa1")))<br />    (setq AA2 (atof (get_tile "aa2")))<br />    (setq LL1 (atof (get_tile "ll1")))<br />    (setq LL2 (atof (get_tile "ll2")))<br /> )<br /> (defun draw_xxx()<br />   ;;以下绘制最上面的侧视图 以左下角点为基准<br />    (setq pt1 (getpoint "左下角基准点:"))<br />    (setq pt2 (polar pt1 0 LL1))<br />    (setq pt3 (polar pt2 (* pi 0.5) (- hh1 hh2)))<br />    (setq pt4 (polar pt3 0 LL2))<br />    (setq pt5 (polar pt4 (* pi 0.5) HH2))<br />    (setq bb (* (/ (sin (* AA1 (/ pi 180))) (cos (* aa1 (/ pi 180)))) (- hh1 hh3)))<br />    (setq pt6 (polar pt5 pi (- (+ LL1 LL2) bb)))<br />    (SETQ pt7 (polar pt1 (* pi 0.5) HH3))<br />    (command "pline" pt1 pt2 pt3 pt4 pt5 pt6 PT7 "C")<br />   ;;以下绘制右边的俯视图以基点下来30mm<br />   (setq pa (polar pt1 (* pi 1.5) 30))<br />   (setq pb (polar pa 0 ll1))<br />   (setq pc (polar pb (* pi 1.5) (/ (- ww1 ww2) 2)))<br />   (setq cc (/ ll2 (cos (* pi (/ aa2 180.0)))))<br />   (setq ee (sqrt (- (* cc cc) (* ll2 ll2))))<br />   (setq pd (polar pc (* pi (- 0 (/ AA2 180))) cc));;;这一行好像不太对,但行的通<br />   (setq pe (polar pd (* pi 1.5) (- ww2 (* ee 2))))<br />   (setq pf (polar pc (* pi 1.5) ww2))<br />   (setq pg (polar pb (* pi 1.5) ww1))<br />   (setq ph (polar pa (* pi 1.5) ww1))<br />   (command "pline" pa pb pc pd pe pf pg ph "c")<br />   ;;;以下绘制左边的侧视图<br />   (setq ea (polar pa pi 30))<br />   (setq eb (polar ea pi hh3))<br />   (setq ec (polar eb (* pi 1.5) (/ (- ww1 ww2) 2)))<br />   (setq ed (polar ec pi (- hh1 hh3)))<br />   (setq ef (polar ed (* pi 1.5) ww2))<br />   (setq eg (polar ef 0 (- hh1 hh3)))<br />   (setq eh (polar eg (* pi 1.5) (/ (- ww1 ww2) 2)))<br />   (setq ej (polar ea (* pi 1.5) ww1))<br />   (command "pline" ea eb ec ed ef eg eh ej "c")<br />   (setvar "osmode" 1)<br /> (prin1)<br /> (prompt "\n      行位已绘制完毕，如有更好建议，请联系QQ609719845")<br /> (PRIN1)<br />   )

soly2006

处女作，乍没见红

xshrimp

不错,角度aa1的:edit_box没有对齐啊.

lincctw_ccl

虽然用不上!!不过还是要给你一个

qfkxc

学习两个月达到如此程度了不起

leslie114

再接再厉会有更大成果

sen.sam

作为练习不错，其实真正在工作中很少这样画。幻灯片的三视图上有些线条没有，像正视图和顶视图没表现出挂台。另外应该在幻灯片中标上插入点，长度的输入框后可以做一个测量的按钮，直接测量图面的距离，不需要自己手动输入。

yjr111

我觉得要用户这么多输入是不是太累了？

logitechlike

command 尽量用 vla- vl- vlax- 开头的vlisp函数处理
没有出错处理, 数据越界检查,
整体*error*处理等. 加油

328302216

虽然用不上也顶一下