《lisp做CAD的计算器.pdf》由会员分享，可在线阅读，更多相关《lisp做CAD的计算器.pdf（8页珍藏版）》请在taowenge.com淘文阁网|工程机械CAD图纸|机械工程制图|CAD装配图下载|SolidWorks_CaTia_CAD_UG_PROE_设计图分享下载上搜索。
1、(defun c:SZYS(/dcl_id Dialog_Return key keys Dcl_File)(vl-load-com)(setq dcl_id(load_dialog(setq Dcl_File(Write_Dcl_SZYS);对话框加载 (vl-file-delete Dcl_File);加载后删除 DCL 文件 (setq Dialog_Return 2)(while(Dialog_Return 1);循环控制对话框是否结束 (new_dialog SZYS dcl_id);建立窗体 ;-对话框初始化-(setq keys(Command1 Command2 Command
2、3 Command4 Check1 Check2 Check3 accept cancel);列表全部控件名称 (foreach key keys;全部控件的初始化 (action_tile key(Action_SZYS_Keys$key$value);点击动作 );-对话框初始化完成-string (mapcar (function (lambda(a b c)(if (or(47 b 58)(and(=45 b)(47 c 58)(not(47 a 58)(and(=46 b)(47 a 58)(list text)(defun c+(csz zms dfm/gr height lst
3、obj sel spc ss tobj tstr)(if(setq ss(ssget(0.*TEXT)(progn (setq doc(vla-get-ActiveDocument(vlax-get-acad-object);获取当前的图形 spc(if(zerop(vla-get-ActiveSpace doc);切换至模型空间 (if(=(vla-get-MSpace doc):vlax-true);允许从浮动图纸空间视口编辑模型 (vla-get-ModelSpace doc);取得文件的 ModelSpace 集合 (vla-get-PaperSpace doc);取得文件的 Pape
4、rSpace 集合 )(vla-get-ModelSpace doc)(vlax-for Obj(setq sel(vla-get-ActiveSelectionSet doc);取得图形激活的选择集 (cond (=csz 1)(setq lst(cons(distof(vla-get-TextString Obj)2)lst)(=zms 1)(setq lst(cons(LM:ParseNumbers(vla-get-TextString Obj)lst)(setq Height(vla-get-Height Obj)(setq lst(reverse lst)(setq tStr(rto
5、s(apply+(vl-remove-if null lst)2 3)(vla-put-Alignment (setq tObj(vla-addText spc tStr(vla-getVariable doc VIEWCTR)(*Height 2)acAlignmentMiddleCenter )(vla-put-Color tObj acRed);字体颜色 红 (while(eq 5(car(setq gr(grread t 5 0)(vla-move tObj(vla-get-TextAlignmentPoint tObj)(vlax-3D-point(cadr gr)(vla-dele
6、te sel)(princ)(defun c-(csz zms dfm/gr height lst obj sel spc ss tobj tstr)(if(setq ss(ssget(0.*TEXT)(progn (setq doc(vla-get-ActiveDocument(vlax-get-acad-object)spc(if(zerop(vla-get-ActiveSpace doc)(if(=(vla-get-MSpace doc):vlax-true)(vla-get-ModelSpace doc)(vla-get-PaperSpace doc)(vla-get-ModelSpa
7、ce doc)(vlax-for Obj(setq sel(vla-get-ActiveSelectionSet doc)(cond (=csz 1)(setq lst(cons(distof(vla-get-TextString Obj)2)lst)(=zms 1)(setq lst(cons(LM:ParseNumbers(vla-get-TextString Obj)lst)(setq Height(vla-get-Height Obj)(setq lst(reverse lst)(setq tStr(rtos(apply-(vl-remove-if null lst)2 3)(vla-
8、put-Alignment (setq tObj(vla-addText spc tStr(vla-getVariable doc VIEWCTR)(*Height 2)acAlignmentMiddleCenter )(vla-put-Color tObj acRed)(while(eq 5(car(setq gr(grread t 5 0)(vla-move tObj(vla-get-TextAlignmentPoint tObj)(vlax-3D-point(cadr gr)(vla-delete sel)(princ)(defun c*(csz zms dfm/gr height ls
9、t obj sel spc ss tobj tstr)(if(setq ss(ssget(0.*TEXT)(progn (setq doc(vla-get-ActiveDocument(vlax-get-acad-object)spc(if(zerop(vla-get-ActiveSpace doc)(if(=(vla-get-MSpace doc):vlax-true)(vla-get-ModelSpace doc)(vla-get-PaperSpace doc)(vla-get-ModelSpace doc)(vlax-for Obj(setq sel(vla-get-ActiveSele
10、ctionSet doc)(cond (=csz 1)(setq lst(cons(distof(vla-get-TextString Obj)2)lst)(=zms 1)(setq lst(cons(LM:ParseNumbers(vla-get-TextString Obj)lst)(setq Height(vla-get-Height Obj)(setq lst(reverse lst)(setq tStr(rtos(apply*(vl-remove-if null lst)2 3)(vla-put-Alignment (setq tObj(vla-addText spc tStr(vl
11、a-getVariable doc VIEWCTR)(*Height 2)acAlignmentMiddleCenter )(vla-put-Color tObj acRed)(while(eq 5(car(setq gr(grread t 5 0)(vla-move tObj(vla-get-TextAlignmentPoint tObj)(vlax-3D-point(cadr gr)(vla-delete sel)(princ)(defun c/(csz zms dfm/gr height lst obj sel spc ss tobj tstr)(if(setq ss(ssget(0.*
12、TEXT)(progn (setq doc(vla-get-ActiveDocument(vlax-get-acad-object)spc(if(zerop(vla-get-ActiveSpace doc)(if(=(vla-get-MSpace doc):vlax-true)(vla-get-ModelSpace doc)(vla-get-PaperSpace doc)(vla-get-ModelSpace doc)(vlax-for Obj(setq sel(vla-get-ActiveSelectionSet doc)(cond (=csz 1)(setq lst(cons(distof
13、(vla-get-TextString Obj)2)lst)(=zms 1)(setq lst(cons(LM:ParseNumbers(vla-get-TextString Obj)lst)(setq Height(vla-get-Height Obj)(setq lst(reverse lst)(setq tStr(rtos(apply/(vl-remove-if null lst)2 3)(vla-put-Alignment (setq tObj(vla-addText spc tStr(vla-getVariable doc VIEWCTR)(*Height 2)acAlignment
14、MiddleCenter )(vla-put-Color tObj acRed)(while(eq 5(car(setq gr(grread t 5 0)(vla-move tObj(vla-get-TextAlignmentPoint tObj)(vlax-3D-point(cadr gr)(vla-delete sel)(princ)(defun Action_SZYS_Keys(key value);全部控件的点击动作触发 (cond (=key accept)(done_dialog 1)(=key cancel)(done_dialog 0)(=key Command1);+(按钮)
15、(setq csz(get_tile Check1)(setq zms(get_tile Check2)(setq dfm(get_tile Check3)(done_dialog 3)(=key Command2)(done_dialog 4);-(按钮)(=key Command3)(done_dialog 5);(按钮)(=key Command4)(done_dialog 6);(按钮)(=key Check1);纯数字(多选按钮)(progn (set_tile Check2 0)(set_tile Check3 0)(setq csz(get_tile Check1)(=key C
16、heck2);字母数字混合(多选按钮)(progn (set_tile Check1 0)(set_tile Check3 0)(setq zms(get_tile Check2)(=key Check3);度分秒(多选按钮)(progn (set_tile Check1 0)(set_tile Check2 0)(setq dfm(get_tile Check3)(defun Write_Dcl_SZYS(/Dcl_File file str)(setq Dcl_File(vl-filename-mktemp nil nil.Dcl)(setq file(open Dcl_File w)(f
17、oreach str(SZYS:dialog label=四则运算(图面拾取数字);:boxed_column :row :button key=Command1;label=+;width=6.15;height=1.275;:button key=Command2;label=-;width=6.15;height=1.275;:button key=Command3;label=;width=6.15;height=1.275;:button key=Command4;label=;width=6.15;height=1.275;:row :toggle key=Check1;label=纯数字;width=8.55;height=1.275;value=1;:toggle key=Check2;label=字母、汉字、数字混合;width=14.55;height=1.275;:toggle key=Check3;label=度分秒;width=8.55;height=1.275;ok_cancel;)(write-line str file)(close file)Dcl_File)