处女作，本人开发第一个程序，明经第一时间低调发布
来明经学LISP已快有两个月，还是谢谢各位大侠帮忙，，，
以下为小弟写的小软件，，呵呵，不足之处望改进（小弟才学一两个月，肯定很多不懂的，，给点意见吧）
;;;本程序由用户自定义参数快速绘制模具行位三视图
;;; by tony 20111125
;;;CAD使用命令：XXX
;;;
(alert "欢迎使用本程序，若要更多相关程序，请联系QQ：609719845")
(defun c:xxx()
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(dcl_xxx)
(prin1)
)
(defun dcl_xxx()
(setq dcl_id (load_dialog "xxx"))
(new_dialog "xxx" dcl_id)
(def_xxx)
(action_tile "kimage1" "(setq ddtype 1)")
(action_tile "accept" "(ok_xxx)(done_dialog 1)")
(setq dd(start_dialog))
(if (= dd 1)
(draw_xxx)
)
)
(defun def_xxx()
(set_tile "aa1" "15")
(set_tile "aa2" "5")
(set_tile "ww1" "53")
(set_tile "ww2" "43")
(set_tile "hh1" "38")
(set_tile "hh2" "23")
(set_tile "hh3" "6")
(set_tile "ll1" "45")
(set_tile "ll2" "30")
(setq sldkey_list '("kimage1"))
(setq sld_list '("xxx"))
(mapcar 'show_sld sldkey_list sld_list)
)
(defun show_sld(key sld)
(setq x (dimx_tile key))
(setq y (dimy_tile key))
(start_image key)
(fill_image 0 0 x y -2)
(slide_image 0 0 x y sld)
(end_image)
)
(defun ok_xxx()
(setq WW1 (atof (get_tile "ww1")))
(setq WW2 (atof (get_tile "ww2")))
(setq HH1 (atof (get_tile "hh1")))
(setq HH2 (atof (get_tile "hh2")))
(setq HH3 (atof (get_tile "hh3")))
(setq AA1 (atof (get_tile "aa1")))
(setq AA2 (atof (get_tile "aa2")))
(setq LL1 (atof (get_tile "ll1")))
(setq LL2 (atof (get_tile "ll2")))
)
(defun draw_xxx()
;;以下绘制最上面的侧视图 以左下角点为基准
(setq pt1 (getpoint "左下角基准点:"))
(setq pt2 (polar pt1 0 LL1))
(setq pt3 (polar pt2 (* pi 0.5) (- hh1 hh2)))
(setq pt4 (polar pt3 0 LL2))
(setq pt5 (polar pt4 (* pi 0.5) HH2))
(setq bb (* (/ (sin (* AA1 (/ pi 180))) (cos (* aa1 (/ pi 180)))) (- hh1 hh3)))
(setq pt6 (polar pt5 pi (- (+ LL1 LL2) bb)))
(SETQ pt7 (polar pt1 (* pi 0.5) HH3))
(command "pline" pt1 pt2 pt3 pt4 pt5 pt6 PT7 "C")
;;以下绘制右边的俯视图以基点下来30mm
(setq pa (polar pt1 (* pi 1.5) 30))
(setq pb (polar pa 0 ll1))
(setq pc (polar pb (* pi 1.5) (/ (- ww1 ww2) 2)))
(setq cc (/ ll2 (cos (* pi (/ aa2 180.0)))))
(setq ee (sqrt (- (* cc cc) (* ll2 ll2))))
(setq pd (polar pc (* pi (- 0 (/ AA2 180))) cc));;;这一行好像不太对,但行的通
(setq pe (polar pd (* pi 1.5) (- ww2 (* ee 2))))
(setq pf (polar pc (* pi 1.5) ww2))
(setq pg (polar pb (* pi 1.5) ww1))
(setq ph (polar pa (* pi 1.5) ww1))
(command "pline" pa pb pc pd pe pf pg ph "c")
;;;以下绘制左边的侧视图
(setq ea (polar pa pi 30))
(setq eb (polar ea pi hh3))
(setq ec (polar eb (* pi 1.5) (/ (- ww1 ww2) 2)))
(setq ed (polar ec pi (- hh1 hh3)))
(setq ef (polar ed (* pi 1.5) ww2))
(setq eg (polar ef 0 (- hh1 hh3)))
(setq eh (polar eg (* pi 1.5) (/ (- ww1 ww2) 2)))
(setq ej (polar ea (* pi 1.5) ww1))
(command "pline" ea eb ec ed ef eg eh ej "c")
(setvar "osmode" 1)
(prin1)
(prompt "\n 行位已绘制完毕，如有更好建议，请联系QQ609719845")
(PRIN1)
)
处女作，乍没见红 虽然用不上!!不过还是要给你一个 虽然用不上!!不过还是要给你一个
本帖最后由 xshrimp 于 2011-11-25 09:09 编辑
不错,角度aa1的:edit_box没有对齐啊. 虽然用不上!!不过还是要给你一个 学习两个月达到如此程度了不起 再接再厉会有更大成果 作为练习不错，其实真正在工作中很少这样画。幻灯片的三视图上有些线条没有，像正视图和顶视图没表现出挂台。另外应该在幻灯片中标上插入点，长度的输入框后可以做一个测量的按钮，直接测量图面的距离，不需要自己手动输入。 我觉得要用户这么多输入是不是太累了？ command 尽量用 vla- vl- vlax- 开头的vlisp函数处理
没有出错处理, 数据越界检查,
整体*error*处理等. 加油 虽然用不上也顶一下