请朋友们帮忙排查一个问题吧，关于dcl控件的

dragoon33333 · 发表于 2014-12-19 18:04

本帖最后由 dragoon33333 于 2014-12-19 19:43 编辑

大家好，我已经学习lisp三个月了，这几天编写了一个小程序，程序的代码有一部分是从网上搜的，有一部分自己写的。随着功能的增加，出现了一个错误。自己排查了一下午，没找到问题根源。请大家帮忙排查一下。
这个程序是采用dcl控件设置参数，然后根据桩号、坐标跟相关参数进行自动布桩的，中午的时候基本运行的没问题了，但是没备份，下午添加了一些判断后，直接出错了。
程序启动 tt1

ZZXXQQ · 发表于 2014-12-20 09:49

(defun c:tt1();此部分是测试代码用
(vl-load-com)
(settc)
(setwz)
(bzform_load)
(princ)
)
(defun bzform_load( / dcl_id Dialog_Return key keys Dcl_File)
(setq dcl_id (load_dialog (setq Dcl_File (Write_Dcl_bzform))));对话框加载
(vl-file-delete Dcl_File);加载后删除DCL文件
(setq Dialog_Return 2)
(while (> Dialog_Return 1);循环控制对话框是否结束
(new_dialog "bzform" dcl_id);建立窗体
;-->-->-对话框初始化->-->--
(setq keys '("Text4" "Command1" "Combo1" "Combo2" "Text1" "Text2" "Check1" "Text3" "Text5" "Check2" "Combo3" "Check3" "Command2" "accept" "cancel" "Command3"))
(start_list "Combo1");下拉列表 {"Combo1"} 初始化
(mapcar 'add_list tclist);添加列表项
(end_list)
(start_list "Combo2");下拉列表 {"Combo2"} 初始化
(mapcar 'add_list wzlist);添加列表项
(end_list)
(start_list "Combo3");下拉列表 {"Combo3"} 初始化
(mapcar 'add_list tclist);添加列表项
(end_list)
(foreach key keys ;全部控件的初始化
(if (eval (read (strcat key "_bak"))) (set_tile key (eval (read (strcat key "_bak")))));控件内容
(mapcar 'set_tile
'("combo1" "Text5" "Text3" "Text2" "Text1" "combo2" "combo3" "Check1" "Check2" "Check3")
'("0" "5" "10" "0" "20" "0" "0" "1" "1" "1")
)
(action_tile key "(Action_bzform_Keys $$key $$value)");点击动作
)
;--<--<-对话框初始化完成-<--<--
(setq Dialog_Return (start_dialog));开启对话框(用户可见)
)
(unload_dialog dcl_id);退出时卸载对话框
(princ);防止函数回显
)
(defun Action_bzform_Keys (key value);全部控件的点击动作触发
(cond
((= key "accept");{确认按钮}
(Get_bzform_Data)
(setgd)
(setjd)
(setbj)
(buzhuang)
(setq tclist nil wzlist nil zdlist nil)
(redraw)
(done_dialog 1);对话框退出返回主函数传递给Dialog_Return值为1
)
((= key "cancel");{取消按钮}
(setq tclist nil wzlist nil zdlist nil)
(done_dialog 0);对话框退出返回主函数传递给Dialog_Return值为0
)
((= key "Command1"); {"选择"} (按钮)
(readzh)
)
((= key "Combo1"); {} (下拉列表)
(if (= "1" (get_tile "Check3"))
(set_tile "Combo3" (get_tile "Combo1"))
)
)
((= key "Combo2"); {} (下拉列表)
()
)
((= key "Check1"); {"是否绘制圆圈"} (多选按钮)
()
)
((= key "Check2"); {"是否绘制中线"} (多选按钮)
()
)
((= key "Combo3"); {} (下拉列表)
(if (/= (get_tile "Combo1") (get_tile "Combo3"))
(set_tile "Check3" "0")
(set_tile "Check3" "1")
)
)
((= key "Check3"); {"图层同桩号"} (多选按钮)
(if (= "1" (get_tile "Check3"))
(set_tile "Combo3" (get_tile "Combo1"))
)
)
((= key "Command2"); {"保存设置"} (按钮)
()
)
((= key "Command3"); {"测试按钮"} (按钮)
(test1)
)
((= key "Text1"); {"高度"} (输入框)
()
)
((= key "Text2"); {"旋转角度"} (输入框)
()
)
((= key "Text3"); {"圆圈半径"} (输入框)
()
)
((= key "Text5"); {"线宽"} (输入框)
()
)
)
)
(defun Get_bzform_Data( / key);临时生成Dcl文件返回文件名
(foreach key keys
(set (read (strcat key "_bak")) (get_tile key));每个控件都赋给一个变量用于下次开启初始化
)
)
(defun Write_Dcl_bzform( / Dcl_File file str);制作dcl控件
(setq Dcl_File (vl-filename-mktemp nil nil ".Dcl"))
(setq file (open Dcl_File "w"))
(foreach str '(
"bzform:dialog{"
" label="布桩设置";"
" :boxed_column{"
" label="选择桩点坐标文件";"
" :row{"
" :edit_box{key="Text4";label="文件路径：";width=50;}"
" :button{key="Command1";label="选择";width=4;}"
" }"
" }"
" :boxed_column{"
" label="桩号设置项";"
" :row{"
" :popup_list{key="Combo1";label="图层：";width=14.55;}"
" :popup_list{key="Combo2";label="文字样式：";width=15.75;}"
" }"
" :row{"
" :edit_box{key="Text1";label="高度：";width=6.15;}"
" :edit_box{key="Text2";label="旋转角度：";width=4.95;}"
" :text{key="Label3";width=16.95;}"
" }"
" :row{"
" :toggle{key="Check1";label="是否绘制圆圈";width=14.55;}"
" :edit_box{key="Text3";label="圆圈半径：";width=6.15;}"
" :text{key="Label4";width=15.75;}"
" }"
" }"
" :boxed_column{"
" label="中线设置项";"
" :row{"
" :toggle{key="Check2";label="是否绘制中线";width=14.55;}"
" :popup_list{key="Combo3";label="图层：";width=10.95;}"
" :toggle{key="Check3";label="图层同桩号";width=12.15;}"
" :edit_box{key="Text5";label="线宽：";width=6.15;}"
" }"
" }"
" :row{"
" :button{key="Command2";label="保存设置";width=9.75;}"
" :button{key="accept";label="确定";width=13.35;is_default=true;}"
" :button{key="cancel";label="取消";width=13.35;is_cancel=true;}"
" :button{key="Command3";label="测试控件";width=9.75;}"
" }"
"}"
)
(write-line str file)
)
(close file)
Dcl_File
)
(defun readzh ( / pe fel);打开txt文件获取其中坐标成表
(setq path (getfiled "打开坐标文件" "C:/Users/anmeng/Desktop/" "txt" 0))
(setq screw_list nil)
(if path (progn
(setq pe (open path "r"))
(setq fel T)
(while (/= fel nil)
(setq fel (read-line pe))
(setq screw_list (cons fel screw_list))
)
(close pe)
(setq screw_list (cdr (reverse (cdr screw_list))))
)
(if (= nil (get_tile "Text4")) (alert "请选取坐标文件")
(progn
(setq pe (open (get_tile "Text4") "r"))
(setq fel T)
(while (/= fel nil)
(setq fel (read-line pe))
(setq screw_list (cons fel screw_list))
)
(close pe)
(setq screw_list (cdr (reverse (cdr screw_list))))
))
)
(set_tile "Text4" path)
)
(defun test1 ()
(setq abh (get_tile "combo1"))
(alert abh)
(setq abi (get_tile "combo2"))
(alert abi)
(setq abj (get_tile "combo3"))
(alert abj)
(setq wztc (nth (read (get_tile "Combo1")) tclist))
(alert wztc)
)
(defun setgd ();获取文字高度
(if (= nil (get_tile "Text1"))
(setq gd (atof Text1_bak))
(setq gd (atof (get_tile "Text1")))
)
)
(defun setjd ();获取文字旋转角度
(if (= nil (get_tile "Text2"))
(setq jd Text2_bak)
(setq jd (get_tile "Text2"))
)
)
(defun setbj ();获取圆圈半径
(if (= nil (get_tile "Text3"))
(setq bj (atof Text3_bak))
(setq bj (atof (get_tile "Text3")))
)
)
(defun settc ( / tc tcm);获取图层集合的表
(vlax-for tcm (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))
(progn
(setq tc (vla-get-name tcm))
(setq tclist (cons tc tclist))
))
(setq tclist (reverse tclist))
)
(defun setwz ( / wz wzm);获取文字样式集合的表
(vlax-for wzm (vla-get-textstyles (vla-get-activedocument (vlax-get-acad-object)))
(if (/= (vla-get-name wzm) "Annotative")
(progn
(setq wz (vla-get-name wzm))
(setq wzlist (cons wz wzlist))
)))
(setq wzlist (reverse wzlist))
)
(defun buzhuang()
(setq wztc (nth (read (get_tile "Combo1")) tclist))
(setq wzys (nth (read (get_tile "Combo2")) wzlist))
(foreach pt0 screw_list;按每个点写桩号
(setq pt1 (parse pt0 "\t"))
(entmake (append (list '(0 . "MTEXT") '(100 . "AcDbEntity") '(100 . "AcDbMText") (cons 50 (angtof jd 0)) (cons 1 (car pt1)) (cons 7 wzys) (cons 40 gd) (cons 8 wztc) (list 10 (distof (cadr pt1) 2) (distof (caddr pt1) 2) 0)))
)
(if (= "1" (get_tile "Check1"));如果选中画圈复选框，则画圈
(entmake (append (list '(0 . "CIRCLE") '(100 . "AcDbEntity") '(100 . "AcDbCircle") (cons 40 bj) (cons 8 wztc) (list 10 (distof (cadr pt1) 2) (distof (caddr pt1) 2) 0)))
)
)
)
(if (= "1" (get_tile "Check2"));如果选中画线复选框，则画线
(progn
(setq zxz (atof (get_tile "Text5")))
(foreach zd screw_list
(setq zd1 (parse zd "\t"))
(setq zd2 (list 10 (distof (cadr zd1) 2) (distof (caddr zd1) 2)))
(setq zdlist (cons zd2 zdlist))
)
(entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 43 zxz) (cons 90 (length screw_list)) (cons 8 wztc)) zdlist)
)
))
)
(defun parse (str delim / lst pos);以字符截断字符串
(while (setq pos (vl-string-search delim str))
(setq lst (cons (substr str 1 pos) lst)
str (substr str (+ pos 2)))
)
(if (> (strlen str) 0)
(setq lst (cons str lst))
)
(reverse lst)
)

(defun c:tt1();此部分是测试代码用 
 (vl-load-com) 
 (settc) 
 (setwz) 
 (bzform_load) 
 (princ) 
) 
(defun bzform_load( / dcl_id Dialog_Return key keys Dcl_File) 
 (setq dcl_id (load_dialog (setq Dcl_File (Write_Dcl_bzform))));对话框加载 
 (vl-file-delete Dcl_File);加载后删除DCL文件 
 (setq Dialog_Return 2) 
 (while (> Dialog_Return 1);循环控制对话框是否结束 
  (new_dialog "bzform" dcl_id);建立窗体 
;-->-->-对话框初始化->-->-- 
  (setq keys '("Text4" "Command1" "Combo1" "Combo2" "Text1" "Text2" "Check1" "Text3" "Text5" "Check2" "Combo3" "Check3" "Command2" "accept" "cancel" "Command3")) 
  (start_list "Combo1");下拉列表 {"Combo1"} 初始化 
  (mapcar 'add_list tclist);添加列表项 
  (end_list) 
  (start_list "Combo2");下拉列表 {"Combo2"} 初始化 
  (mapcar 'add_list wzlist);添加列表项 
  (end_list) 
  (start_list "Combo3");下拉列表 {"Combo3"} 初始化 
  (mapcar 'add_list tclist);添加列表项 
  (end_list) 
  (foreach key keys ;全部控件的初始化 
   (if (eval (read (strcat key "_bak"))) (set_tile key (eval (read (strcat key "_bak")))));控件内容 
   (mapcar 'set_tile 
    '("combo1" "Text5" "Text3" "Text2" "Text1" "combo2" "combo3" "Check1" "Check2" "Check3") 
    '("0" "5" "10" "0" "20" "0" "0" "1" "1" "1") 
   ) 
   (action_tile key "(Action_bzform_Keys $$key $$value)");点击动作 
  ) 
;--<--<-对话框初始化完成-<--<-- 
  (setq Dialog_Return (start_dialog));开启对话框(用户可见) 
 ) 
 (unload_dialog dcl_id);退出时卸载对话框 
 (princ);防止函数回显 
) 
(defun Action_bzform_Keys (key value);全部控件的点击动作触发 
 (cond 
  ((= key "accept");{确认按钮} 
   (Get_bzform_Data) 
   (setgd) 
   (setjd) 
   (setbj) 
   (buzhuang) 
   (setq tclist nil wzlist nil zdlist nil) 
   (redraw) 
   (done_dialog 1);对话框退出返回主函数 传递给Dialog_Return值为1 
  ) 
  ((= key "cancel");{取消按钮} 
   (setq tclist nil wzlist nil zdlist nil) 
   (done_dialog 0);对话框退出返回主函数 传递给Dialog_Return值为0 
  ) 
  ((= key "Command1"); {"选择"} (按钮) 
   (readzh) 
  ) 
  ((= key "Combo1"); {} (下拉列表) 
   (if (= "1" (get_tile "Check3")) 
    (set_tile "Combo3" (get_tile "Combo1")) 
   ) 
  ) 
  ((= key "Combo2"); {} (下拉列表) 
   () 
  ) 
  ((= key "Check1"); {"是否绘制圆圈"} (多选按钮) 
   () 
  ) 
  ((= key "Check2"); {"是否绘制中线"} (多选按钮) 
   () 
  ) 
  ((= key "Combo3"); {} (下拉列表) 
   (if (/= (get_tile "Combo1") (get_tile "Combo3")) 
    (set_tile "Check3" "0") 
    (set_tile "Check3" "1") 
   ) 
  ) 
  ((= key "Check3"); {"图层同桩号"} (多选按钮) 
   (if (= "1" (get_tile "Check3")) 
    (set_tile "Combo3" (get_tile "Combo1")) 
   ) 
  ) 
  ((= key "Command2"); {"保存设置"} (按钮) 
   () 
  ) 
  ((= key "Command3"); {"测试按钮"} (按钮) 
   (test1) 
  ) 
  ((= key "Text1"); {"高度"} (输入框) 
   () 
  ) 
  ((= key "Text2"); {"旋转角度"} (输入框) 
   () 
  ) 
  ((= key "Text3"); {"圆圈半径"} (输入框) 
   () 
  ) 
  ((= key "Text5"); {"线宽"} (输入框) 
   () 
  ) 
 ) 
) 
(defun Get_bzform_Data( / key);临时生成Dcl文件 返回文件名 
 (foreach key keys 
  (set (read (strcat key "_bak")) (get_tile key));每个控件都赋给一个变量 用于下次开启初始化 
 ) 
) 
(defun Write_Dcl_bzform( / Dcl_File file str);制作dcl控件 
 (setq Dcl_File (vl-filename-mktemp nil nil ".Dcl")) 
 (setq file (open Dcl_File "w")) 
 (foreach str '( 
  "bzform:dialog{" 
  " label="布桩设置";" 
  " :boxed_column{" 
  "  label="选择桩点坐标文件";" 
  "  :row{" 
  "   :edit_box{key="Text4";label="文件路径：";width=50;}" 
  "   :button{key="Command1";label="选择";width=4;}" 
  "  }" 
  " }" 
  " :boxed_column{" 
  "  label="桩号设置项";" 
  "  :row{" 
  "   :popup_list{key="Combo1";label="图层：";width=14.55;}" 
  "   :popup_list{key="Combo2";label="文字样式：";width=15.75;}" 
  "  }" 
  "  :row{" 
  "   :edit_box{key="Text1";label="高度：";width=6.15;}" 
  "   :edit_box{key="Text2";label="旋转角度：";width=4.95;}" 
  "   :text{key="Label3";width=16.95;}" 
  "  }" 
  "  :row{" 
  "   :toggle{key="Check1";label="是否绘制圆圈";width=14.55;}" 
  "   :edit_box{key="Text3";label="圆圈半径：";width=6.15;}" 
  "   :text{key="Label4";width=15.75;}" 
  "  }" 
  " }" 
  " :boxed_column{" 
  "  label="中线设置项";" 
  "  :row{" 
  "   :toggle{key="Check2";label="是否绘制中线";width=14.55;}" 
  "   :popup_list{key="Combo3";label="图层：";width=10.95;}" 
  "   :toggle{key="Check3";label="图层同桩号";width=12.15;}" 
  "   :edit_box{key="Text5";label="线宽：";width=6.15;}" 
  "  }" 
  " }" 
  " :row{" 
  "  :button{key="Command2";label="保存设置";width=9.75;}" 
  "  :button{key="accept";label="确定";width=13.35;is_default=true;}" 
  "  :button{key="cancel";label="取消";width=13.35;is_cancel=true;}" 
  "  :button{key="Command3";label="测试控件";width=9.75;}" 
  " }" 
  "}" 
  ) 
  (write-line str file) 
 ) 
 (close file) 
 Dcl_File 
) 
(defun readzh ( / pe fel);打开txt文件获取其中坐标成表 
 (setq path (getfiled "打开坐标文件" "C:/Users/anmeng/Desktop/" "txt" 0)) 
 (setq screw_list nil) 
 (if path (progn 
  (setq pe (open path "r")) 
  (setq fel T) 
  (while (/= fel nil) 
   (setq fel (read-line pe)) 
   (setq screw_list (cons fel screw_list)) 
  ) 
  (close pe) 
  (setq screw_list (cdr (reverse (cdr screw_list)))) 
 ) 
  (if (= nil (get_tile "Text4")) (alert "请选取坐标文件") 
  (progn 
   (setq pe (open (get_tile "Text4") "r")) 
   (setq fel T) 
   (while (/= fel nil) 
    (setq fel (read-line pe)) 
    (setq screw_list (cons fel screw_list)) 
   ) 
   (close pe) 
   (setq screw_list (cdr (reverse (cdr screw_list)))) 
  )) 
 ) 
 (set_tile "Text4" path) 
) 
(defun test1 () 
(setq abh (get_tile "combo1")) 
(alert abh) 
(setq abi (get_tile "combo2")) 
(alert abi) 
(setq abj (get_tile "combo3")) 
(alert abj) 
(setq wztc (nth (read (get_tile "Combo1")) tclist)) 
(alert wztc) 
) 
(defun setgd ();获取文字高度 
 (if (= nil (get_tile "Text1")) 
  (setq gd (atof Text1_bak)) 
  (setq gd (atof (get_tile "Text1"))) 
 ) 
) 
(defun setjd ();获取文字旋转角度 
 (if (= nil (get_tile "Text2")) 
  (setq jd Text2_bak) 
  (setq jd (get_tile "Text2")) 
 ) 
) 
(defun setbj ();获取圆圈半径 
 (if (= nil (get_tile "Text3")) 
  (setq bj (atof Text3_bak)) 
  (setq bj (atof (get_tile "Text3"))) 
 ) 
) 
(defun settc ( / tc tcm);获取图层集合的表 
 (vlax-for tcm (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))) 
 (progn 
  (setq tc (vla-get-name tcm)) 
  (setq tclist (cons tc tclist)) 
 )) 
 (setq tclist (reverse tclist)) 
) 
(defun setwz ( / wz wzm);获取文字样式集合的表 
 (vlax-for wzm (vla-get-textstyles (vla-get-activedocument (vlax-get-acad-object))) 
 (if (/= (vla-get-name wzm) "Annotative") 
 (progn 
 (setq wz (vla-get-name wzm)) 
 (setq wzlist (cons wz wzlist)) 
 ))) 
 (setq wzlist (reverse wzlist)) 
) 
(defun buzhuang() 
 (setq wztc (nth (read (get_tile "Combo1")) tclist)) 
 (setq wzys (nth (read (get_tile "Combo2")) wzlist)) 
 (foreach pt0 screw_list;按每个点写桩号 
  (setq pt1 (parse pt0 "\t")) 
  (entmake (append (list '(0 . "MTEXT") '(100 . "AcDbEntity") '(100 . "AcDbMText") (cons 50 (angtof jd 0)) (cons 1 (car pt1)) (cons 7 wzys) (cons 40 gd) (cons 8 wztc) (list 10 (distof (cadr pt1) 2) (distof (caddr pt1) 2) 0))) 
  ) 
  (if (= "1" (get_tile "Check1"));如果选中画圈复选框，则画圈 
  (entmake (append (list '(0 . "CIRCLE") '(100 . "AcDbEntity") '(100 . "AcDbCircle") (cons 40 bj) (cons 8 wztc) (list 10 (distof (cadr pt1) 2) (distof (caddr pt1) 2) 0))) 
  ) 
 ) 
 ) 
 (if (= "1" (get_tile "Check2"));如果选中画线复选框，则画线 
 (progn 
  (setq zxz (atof (get_tile "Text5"))) 
  (foreach zd screw_list 
   (setq zd1 (parse zd "\t")) 
   (setq zd2 (list 10 (distof (cadr zd1) 2) (distof (caddr zd1) 2))) 
   (setq zdlist (cons zd2 zdlist)) 
  ) 
  (entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 43 zxz) (cons 90 (length screw_list)) (cons 8 wztc)) zdlist) 
  ) 
 )) 
) 
(defun parse (str delim / lst pos);以字符截断字符串 
 
 (while (setq pos (vl-string-search delim str)) 
  (setq lst (cons (substr str 1 pos) lst) 
        str (substr str (+ pos 2))) 
 ) 
 (if (> (strlen str) 0) 
  (setq lst (cons str lst)) 
 ) 
 (reverse lst) 
)

dragoon33333 · 发表于 2014-12-20 10:17

ZZXXQQ 发表于 2014-12-20 09:49

谢谢版主，已经排查出来了，是（princ）的问题。
然后在功能完善的过程中，还有句代码过不了“(list 10 (+ (* 2 bj) (distof (cadr pt1))) 2)”，
麻烦您帮忙看看这句代码有问题吗？

dragoon33333 · 发表于 2014-12-20 10:48

ZZXXQQ 发表于 2014-12-20 09:49

已经解决了，闭括号放错位置了

账号		自动登录	找回密码
密码			注册

[已解答] 请朋友们帮忙排查一个问题吧，关于dcl控件的

相关帖子