【请教】高手们帮帮忙啊~~~我写的这个lisp哪里有问题啊

jayan1210

对lisp还不是很熟悉，大家帮帮忙，看看我下面的代码哪些地方有问题啊~~

(defun c:hjht()
  (setq os (getvar "OSMODE"))
  (setvar "CMDECHO" 0)
  (setvar "OSMODE" 0)
  (setvar "OSMODE" os)
  (setvar "CMDECHO" 1)
  (dcl_hangji)
  (prin1)
  )
(defun dcl_hangji()
  (setq dcl_id (load_dialog "C:/3.dcl"))
  (if (< dcl_id 0)(exit))
  (while (= dd 1)
  (if (not (new_dialog "hangji" dcl_id))(exit))
  
  (set_tile "b_c" "0.0")
  (set_tile "b_k" "0.0")
  (set_tile "tc_a" "0.0")
  (set_tile "bc_a" "0.0")
  (set_tile "bk_a" "0.0")
  (set_tile "tc_b" "0.0")
  (set_tile "bc_b" "0.0")
  (set_tile "bk_b" "0.0")
  (set_tile "tbc_b" "0.0")
  (set_tile "tbk_b" "0.0")
  (set_tile "tbc_c" "0.0")
  (set_tile "tbk_c" "0.0")
  (set_tile "cj" "0.0")
  (set_tile "tuc_a" "航迹名")
  (set_tile "y_s" "10")
  (set_tile "wjm" ".txt")
  (set_tile "dc" user_dc)
  (dc_user user_dc);
  (set_tile "tc_a" user_tca)
  (tca_user user_tca)
  (set_tile "tc_b" user_tcb)
  (tcb_user user_tcb)
  (action_tile "dc" "(dc_user (get_tile \"dc\")) (getdata)")
  (action_tile "tc_a" "(tca_user (get_tile \"tc_a\")) (getdata)")
  (action_tile "tc_b" "(tcb_user (get_tile \"tc_b\")) (getdata)")
  (action_tile "p_b" "(sub_get_file)")
  (action_tile "accept" "(getdata)(done_dialog 1)")
  (action_tile "cancel" "(done_dialog 0)")
   (setq dd(start_dialog))
   (if(= dd 1)
     (ok_hangji)
  )
  )
  (unload_dialog dcl_id)
)
(defun dc_user (user_dc)  
  (if (= user_dc "0")
     (progn ;开关为关闭状态时
(mode_tile "b_c" 1);禁用
     (mode_tile "b_k" 1);禁用
      )
    (progn ;自开关为打开状态时
(mode_tile "b_c" 0);设置
     (mode_tile "b_k" 0);设置
      )
    )
  )
(defun tca_user (user_tca)  
  (if (= user_tca "0")
     (progn ;自开关为关闭状态时
(mode_tile "bc_a" 1);禁用
(mode_tile "bk_a" 1);禁用
       (mode_tile "tbc_a" 1);禁用
(mode_tile "tbk_a" 1);禁用
      )
    (progn ;开关为打开状态时
(mode_tile "bc_a" 0);设置
(mode_tile "bk_a" 0);设置
       (mode_tile "tbc_a" 0);设置
(mode_tile "tbk_a" 0);设置
      )
    )
  )
(defun tcb_user (user_tcb)  
  (if (= user_tcb "0")
     (progn ;开关为关闭状态时
(mode_tile "bc_b" 1);禁用
(mode_tile "bk_b" 1);禁用
       (mode_tile "tbc_b" 1);禁用
(mode_tile "tbk_b" 1);禁用
       (mode_tile "tbc_c" 1);禁用
(mode_tile "tbk_c" 1);禁用
      )
    (progn ;开关为打开状态时
(mode_tile "bc_b" 0);设置
(mode_tile "bk_b" 0);设置
       (mode_tile "tbc_b" 0);设置
(mode_tile "tbk_b" 0);设置
      (mode_tile "tbc_c" 0);设置
(mode_tile "tbk_c" 0);设置      
      )
    )
  )
(defun sub_get_file()
  (setq f (getfiled "选择文件.txt" "" "" 4))
  (set_tile "wjm" (strcat (getvar "txtprefix") (getvar "txtname")))
  )
  
(defun getdata()
  (setq d (atof (get_tile "cj")))
  (setq tc (get_tile "tuc_a"))
  (setq ys (atof (get_tile "y_s")))
  (setq user_dc(get_tile "dc"))
  (setq user_tca(get_tile "tca"))
  (setq user_tcb(get_tile "tcb"))
  (if (/= user_dc "0")
  (progn
  (setq cc (atof (get_tile "b_c")))
  (setq ck (atof (get_tile "b_k")))
    )
    )
  (if (/= user_tca "0")
  (progn
  (setq cc (atof (get_tile "bc_a")))
  (setq ck (atof (get_tile "bk_a")))
  (setq tbca (atof (get_tile "tbc_a")))
  (setq tbka (atof (get_tile "tbk_a")))
    )
    )
  (if (/= user_tcb "0")
  (progn
  (setq cc (atof (get_tile "bc_b")))
  (setq ck (atof (get_tile "bk_b")))
  (setq tbcb (atof (get_tile "tbc_b")))
  (setq tbkb (atof (get_tile "tbk_b")))
  (setq tbcc (atof (get_tile "tbc_c")))
  (setq tbkc (atof (get_tile "tbk_c")))
    )
    )
  )

(defun ok_hangji()
   (getdata)
   (command "layer" "m" tc "c" ys "" "")
   (setq ff (open f "r"))
   (while(SETQ text0 (READ-LINE ff))
      (setq len (strlen text0))
      (setq n (vl-string-position (ascii ",") text0))
      (setq n0 (vl-string-position (ascii ",") text0 (1+ n)))
      (setq n1 (vl-string-position (ascii ",") text0 (1+ n0)))
      (setq n2 (vl-string-position (ascii ",") text0 (1+ n1)))
      (setq x1 (atof(substr text0 (+ n 2) (- n0 (1+ n))))
            y1 (atof (substr text0 (+ n0 2) (- n1 (1+ n0))))
            x2 (atof(substr text0 (+ n1 2) (- n2 (1+ n1))))
            y2 (atof(substr text0 (+ n2 2))))
     ;(setq dh(atof(substr text0 1 n)) )
     (setq pt1 (list x1 y1))
     (setq pt2 (list x2 y2))
     (setq ang (angle pt1 pt2))
     (setq pt3 (polar pt1 ang d))
     ;(setq pt4(polar pt3 (/ pi 4) 2))
     (setq ang1 (angle pt3 pt1))      
     (setq pt5 (polar pt3 ang1 (- cc 15)))
      
      (setq ang2 (angle pt5 pt3))
      (setq pt6 (polar pt3 (+ (/ pi 2) ang1) (/ ck 2)))
      (setq pt7 (polar pt3 (+ (* pi 1.5) ang1) (/ ck 2)))
      (setq pt8 (polar pt5 (+ (/ pi 2) ang1) (/ ck 2)))
      (setq pt9 (polar pt5 (+ (* pi 1.5) ang1) (/ ck 2)))
      
      (setq pt10 (polar pt3 ang2 15))
      (setq pt11 (polar pt10 (+ (/ pi 2) ang1) (/ ck 4)))
      (setq pt12 (polar pt10 (+ (* pi 1.5) ang1) (/ ck 4)))
(if (/= user_dc "0")
   (progn
     (command "pline" pt11 pt12 pt7 pt9 pt8 pt6 "C")
      (SETVAR "PLINEWID" 0.5)
      )
     )
     
  (if (/= user_tca "0")
  (progn
    (setq pt13 (polar pt1 (+ (/ pi 2) ang1) (/ ck 2)))
    (setq pt14 (polar pt1 (+ (/ pi 2) ang1) (+ (/ ck 2) (/ tbka 2))))
    (setq pt15 (polar pt1 (+ (/ pi 2) ang1) ck))
    (setq pt16 (polar pt14 ang2 20))
    (setq pt17 (polar pt16 (+ (/ pi 2) ang1) (/ tbka 4)))
    (setq pt18 (polar pt16 (+ (* pi 1.5) ang1) (/ tbka 4)))
    (setq pt19 (polar pt16 ang1 tbca))
    (setq pt20 (polar pt19 (+ (/ pi 2) ang1) (/ tbka 2)))
    (setq pt21 (polar pt19 (+ (* pi 1.5) ang1) (/ tbka 2)))
    (command "pline" pt11 pt12 pt7 pt9 pt8 pt6 "C")
    (command "pline" pt17 pt18 pt13 pt21 pt20 pt15 "C")
      (SETVAR "PLINEWID" 0.5)
    )
)
  (if (/= user_tcb "0")
  (progn
    (setq pt13 (polar pt1 (+ (/ pi 2) ang1) (/ ck 2)))
    (setq pt14 (polar pt1 (+ (/ pi 2) ang1) (+ (/ ck 2) (/ tbka 2))))
    (setq pt15 (polar pt1 (+ (/ pi 2) ang1) ck))
    (setq pt16 (polar pt14 ang2 20))
    (setq pt17 (polar pt16 (+ (/ pi 2) ang1) (/ tbkb 4)))
    (setq pt18 (polar pt16 (+ (* pi 1.5) ang1) (/ tbkb 4)))
    (setq pt19 (polar pt16 ang1 tbcb))
    (setq pt20 (polar pt19 (+ (/ pi 2) ang1) (/ tbkb 2)))
    (setq pt21 (polar pt19 (+ (* pi 1.5) ang1) (/ tbkb 2)))
    (setq pt22 (polar pt16 ang2 4))
    (setq pt23 (polar pt22 (+ (/ pi 2) ang1) (/ tbkc 2)))
    (setq pt24 (polar pt22 (+ (* pi 1.5) ang1) (/ tbkc 2)))
    (setq pt25 (polar pt22 ang2 tbcc))
    (setq pt26 (polar pt25 (+ (/ pi 2) ang1) (/ tbkc 4)))
    (setq pt27 (polar pt25 (+ (* pi 1.5) ang1) (/ tbkc 4)))
    (setq pt28 (polar pt16 ang2 (- tbcc 15)))
    (setq pt29 (polar pt28 (+ (/ pi 2) ang1) (/ tbkc 2)))
    (setq pt30 (polar pt28 (+ (* pi 1.5) ang1) (/ tbkc 2)))
   
    (command "pline" pt11 pt12 pt7 pt9 pt8 pt6 "C")
    (command "pline" pt16 pt13 pt21 pt20 pt15 "C")
    (command "pline" pt26 pt27 pt30 pt24 pt23 pt29 "C")
      (SETVAR "PLINEWID" 0.5)
    )
)
     )
    (command "")
  (if ff (close ff))
  (alert "自动生成完毕！")
   
)

llsheng_73

你现在的问题出在什么地方？
程序较长，看起来很慢，
没看到DCL定义，不好调试

jayan1210

llsheng_73 发表于 2013-10-24 12:13
你现在的问题出在什么地方？
程序较长，看起来很慢，
没看到DCL定义，不好调试

这个是DCL，之前对话框闪一下就消失了，但是后来我修改了一下，结果对话框直接不出来了，还不报错


hangji:dialog{
label="航迹图绘制:";


:row{//第一行开始，该行有两个列
:column{
:row{
:boxed_column{
:toggle{label="单  船";//切换开关
key="dc";
value="0";}
:edit_box{label = "船  长:";//定位点x编辑框
key = "b_c";
edit_width =12;
}
:edit_box{label = "船  宽:";//定位点y编辑框
key = "b_k";
edit_width =12;
}}}
:row{
:boxed_column{
:toggle{label="多船-一拖";//切换开关
key="tc_a";
value="0";}

:boxed_column{
:edit_box{label = "船  长:";//定位点x编辑框
key = "bc_a";
edit_width =12;
}
:edit_box{label = "船  宽:";//定位点y编辑框
key = "bk_a";
edit_width =12;
}}
:boxed_column{
:edit_box{label = "拖船长:";//定位点x编辑框
key = "tbc_a";
edit_width =12;
}
:edit_box{label = "拖船宽:";//定位点y编辑框
key = "tbk_a";
edit_width =12;
}}}
}}


:boxed_column{
:toggle{label="多船-二拖";//切换开关
key="tc_b";
value="0";}
:column{
:boxed_column{
:edit_box{label = "船  长:";//定位点x编辑框
key = "bc_b";
edit_width =12;
}
:edit_box{label = "船  宽:";//定位点y编辑框
key = "bk_b";
edit_width =12;
}}}
:column{
:boxed_column{
:edit_box{label = "拖船1长:";//定位点x编辑框
key = "tbc_b";
edit_width =12;
}
:edit_box{label = "拖船1宽:";//定位点y编辑框
key = "tbk_b";
edit_width =12;}
}}
:column{//第二列开始，该列有两个加框列
:boxed_column{
:edit_box{label = "拖船2长:";//定位点x编辑框
key = "tbc_c";
edit_width =12;
}
:edit_box{label = "拖船2宽:";//定位点y编辑框
key = "tbk_c";
edit_width =12;
}}}
}
}

:row{//第二行开始，该行有两个列
:edit_box{label = "测距(米):";
key = "cj";
edit_width =8;
height =1.2;
}
:edit_box{label = "新图层名:";
key = "tuc_a";
edit_width =8;
height =1.2;
}
:edit_box{label = "图层颜色值(0~255):";
key = "y_s";
edit_width =8;
height =1.2;
}
}

:row{
:popup_list{label="文件名:";
                  key="wjm";
                  value=".txt";
                 }
:button{label = "浏  览";//光标拾取按钮
key = "p_b";
width =3;
fixed_width=true;
height =1.5;}
}

:row{//第三行开始，该行有两个列
spacer_1;
    :button{label= "确定";
            key = "accept";
            width =3;           
            is_default=true;         
           }
spacer_1;
    :button{label= "取消";
            key = "cancel";
            width =3;         
           }
    spacer_1;
     }

}

llsheng_73

jayan1210 发表于 2013-10-24 12:37
这个是DCL，之前对话框闪一下就消失了，但是后来我修改了一下，结果对话框直接不出来了，还不报错

也就是说你现在问题是对话框没有按需要出来让你操作？确实是这样的，你在(load_dialog dclfile)之后，运行了

(new_dialog dlgname dcl_id [action [screen-pt]])，这些只是运行对话框的预处理，并不是真正的运行对话框，

要让对话框真正运行起来，得在后边运行(strat_dialog)
你仔细看下我给的例子
(setq dcl(load_dialog "SZGX")ctl 3)
      (while (> ctl 2) (new_dialog "DKSZ" dcl)
(setq ldfz(getvar"USERR2")
       lz(fix(/ ldfz 100))
       lf(fix(/(- ldfz(* lz 100)) 10))
       ld(fix(- ldfz(+(* lz 100)(* lf 10)))))
(set_tile "BMX"(RTOS(getvar"USERR3")2 0))
(set_tile "BMZ"(RTOS(getvar"USERR4")2 0))
(set_tile "BMC"(RTOS(getvar"USERR5")2 0))
(set_tile "LZ"(RTOS lz 2 0))
(set_tile "LF"(RTOS lf 2 0))
(set_tile "LD"(RTOS ld 2 0))
(action_tile "GO" "(getdata)(done_dialog 1)")
(action_tile "ESC" "(done_dialog 0)")
(setq ctl (start_dialog)))

jayan1210

llsheng_73 发表于 2013-10-24 12:45
也就是说你现在问题是对话框没有按需要出来让你操作？

是的，估计lisp代码里面还有一些问题，那个打开文件sub_get_file这里我也不知道对不对~~~可不可以麻烦指导一下啊

llsheng_73

jayan1210 发表于 2013-10-24 12:52
是的，估计lisp代码里面还有一些问题，那个打开文件sub_get_file这里我也不知道对不对~~~可不可以麻烦指导 ...

你先看下我在上边给你的例子，让对话框出现让你可以操作了再去调试哪里有没问题吧

jayan1210

llsheng_73 发表于 2013-10-24 13:02
你先看下我在上边给你的例子，让对话框出现让你可以操作了再去调试哪里有没问题吧

我对照你上面给的那个例子修改了下面这段代码，但是对话框还是闪一下就没有了啊~~~~~
(defun dcl_hangji()
  (setq dcl_id (load_dialog "C:/3.dcl") dd 2)
  ;(if (< dcl_id 0)(exit))
  (while (> dd 1)(new_dialog "hangji" dcl_id)
  
  (set_tile "b_c" "0.0")
  (set_tile "b_k" "0.0")
  (set_tile "tc_a" "0.0")
  (set_tile "bc_a" "0.0")
  (set_tile "bk_a" "0.0")
  (set_tile "tc_b" "0.0")
  (set_tile "bc_b" "0.0")
  (set_tile "bk_b" "0.0")
  (set_tile "tbc_b" "0.0")
  (set_tile "tbk_b" "0.0")
  (set_tile "tbc_c" "0.0")
  (set_tile "tbk_c" "0.0")
  (set_tile "cj" "0.0")
  (set_tile "tuc_a" "航迹名")
  (set_tile "y_s" "10")
  (set_tile "wjm" ".txt")

  (set_tile "dc" user_dc)
  (dc_user user_dc);
  (set_tile "tc_a" user_tca)
  (tca_user user_tca)
  (set_tile "tc_b" user_tcb)
  (tcb_user user_tcb)
  (action_tile "dc" "(dc_user (get_tile \"dc\")) (getdata)")
  (action_tile "tc_a" "(tca_user (get_tile \"tc_a\")) (getdata)")
  (action_tile "tc_b" "(tcb_user (get_tile \"tc_b\")) (getdata)")
  (action_tile "p_b" "(sub_get_file)")
  (action_tile "accept" "(getdata)(done_dialog 1)")
  (action_tile "cancel" "(done_dialog 0)")
   (setq dd(start_dialog))
   (if(= dd 1)
     (ok_hangji)
  )
  )
  ;(unload_dialog dcl_id)
)

llsheng_73

jayan1210 发表于 2013-10-24 13:14
我对照你上面给的那个例子修改了下面这段代码，但是对话框还是闪一下就没有了啊~~~~~
(defun dcl_hangji ...

  (set_tile "wjm" ".txt")
   (set_tile "dc" user_dc)
   (dc_user user_dc);
   (set_tile "tc_a" user_tca)
   (tca_user user_tca)
   (set_tile "tc_b" user_tcb)
   (tcb_user user_tcb)
上边红色标出来的地方都是不行的，好象它们都没有事先定义哦
我把它们都去掉了就出来了。。

jayan1210

llsheng_73 发表于 2013-10-24 13:55
(set_tile "wjm" ".txt")
   (set_tile "dc" user_dc)
   (dc_user user_dc);

非常感谢~~~还想麻烦问一下，要怎么提取我打开文件的文件名呢？在运行的时候会提示错误: 【参数类型错误: stringp nil】，并且我把这个提取文件名的注释掉之后，虽然可以运行，但是点击确定的时候也提示错误【参数类型错误: stringp nil】，这是为什么啊，麻烦啦~

llsheng_73

jayan1210 发表于 2013-10-24 14:27
非常感谢~~~还想麻烦问一下，要怎么提取我打开文件的文件名呢？在运行的时候会提示错误: 【参数类型错误: ...

什么文件名？
当前图形文件还是用(Getfiled ) 得到的