大侠帮忙看看这个dcl触发按钮动作哪里错了？

鲑鱼扬帆 · 发表于 2014-8-15 16:47:21

(defun c:dt()
(Form1_load)
)
(defun Form1_load( / dcl_id Dialog_Return key keys Dcl_File)
(vl-load-com)
(setq dcl_id (load_dialog (setq Dcl_File
(Write_Dcl_Form1))));对话框加载
(vl-file-delete Dcl_File);加载后删除DCL文件
(setq Dialog_Return 2)
(while (> Dialog_Return 1) ;循环控制对话框是否结束
(new_dialog "Form1" dcl_id);建立窗体
;-->-->-对话框初始化->-->--
(setq keys '("Command1" "accept" "cancel"));列表全
部控件名称
(foreach key keys;全部控件的初始化
(if (eval (read (strcat key "_bak")))
(set_tile key (eval (read (strcat key "_bak")))));控件内容
(action_tile key "(Action_Form1_Keys $key
$value)");点击动作
)
;--<--<-对话框初始化完成-<--<--
(setq Dialog_Return (start_dialog));开启对话框(用
户可见)
)
(unload_dialog dcl_id);退出时卸载对话框
(princ);防止函数回显
)
(defun Action_Form1_Keys (key value) ;全部控件的点击动作触发
(cond
((= key "accept") ;{确认按钮}
(Get_Form1_Data)
(done_dialog 1);对话框退出返回主函数传递
给Dialog_Return值为1
)
((= key "cancel") ;{取消按钮}
(done_dialog 0);对话框退出返回主函数传递
给Dialog_Return值为0
)
((= key "Command1") ; {"Command1"} (按钮)
(c:eww)
)
)
)
(defun Get_Form1_Data( / key);临时生成Dcl文件返回文件名
(foreach key keys
(set (read (strcat key "_bak")) (get_tile key));每
个控件都赋给一个变量用于下次开启初始化
)
)
(defun Write_Dcl_Form1( / Dcl_File file str)
(setq Dcl_File (vl-filename-mktemp nil nil ".Dcl"))
(setq file (open Dcl_File "w"))
(foreach str '(
"Form1:dialog"
"{"
" label = \"Form1\";"
" :row"
" {"
" :button"
" {"
" key = \"Command1\" ;"
" label = \"Command1\" ;"
" width = 26.55 ;"
" height = 5.475 ;"
" }"
" :text"
" {"
" key = \"Label1\" ;"
" width = 48.15 ;"
" height = 6.075 ;"
" }"
" }"
"ok_cancel ;"
"}"
)
(write-line str file)
)
(close file)
Dcl_File
)
;|
/* 自动备份FRM文件内容
VERSION 5.00
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 6450
ClientLeft = 120
ClientTop = 450
ClientWidth = 9675
LinkTopic = "Form1"
ScaleHeight = 6450
ScaleWidth = 9675
StartUpPosition = 3 '窗口缺省
Begin VB.CommandButton Command1
Caption = "Command1"
Height = 1095
Left = 1080
TabIndex = 0
Top = 960
Width = 2655
End
Begin VB.Label Label1
Caption = "Label1"
Height = 1215
Left = 4200
TabIndex = 1
Top = 1200
Width = 4815
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
*/
|;
(defun c:eww(/ x0 y0 x1 y1)
(gxl-error-init1 (list ‘blipmode 0 ‘cmdecho 0 ‘osmode 0) ‘tt1
2) ;_ 出错只编组
(defun tt1 () ;_ 出错后*error*要执行的动作
(alert "出错啦！")
)
(setvar "cmdecho" 0 )
(SetQ p0 (GetPoint "\n 第一角点：") x0(car p0) y0(cadr p0)
p1 (getcorner p0 "\n 另一角点：") x1(car p1) y1(cadr p1)
dx (abs (- x0 x1))
dy (abs (- y0 y1))
)
(Command "rectang" p0 p1)
(if(<= dx dy)
(SetQ al (/ dx 8))
(SetQ al (/ dy 8)))
(Command "revcloud" "a" al al "s" "c" "o" "l" "")
(setvar "cmdecho" 1)
(gxl-error-end)
(prinC)
)

(defun c:dt() 
  (Form1_load) 
) 
 
(defun Form1_load( / dcl_id Dialog_Return key keys Dcl_File) 
  (vl-load-com) 
  (setq dcl_id (load_dialog (setq Dcl_File 
 
(Write_Dcl_Form1))));对话框加载 
  (vl-file-delete Dcl_File);加载后删除DCL文件 
  (setq Dialog_Return 2) 
  (while (> Dialog_Return 1) ;循环控制对话框是否结束 
    (new_dialog "Form1" dcl_id);建立窗体 
;-->-->-对话框初始化->-->-- 
    (setq keys '("Command1" "accept" "cancel"));列表全 
 
部控件名称 
    (foreach key keys;全部控件的初始化 
      (if (eval (read (strcat key "_bak"))) 
 
(set_tile key (eval (read (strcat key "_bak")))));控件内容 
      (action_tile key "(Action_Form1_Keys $key 
 
$value)");点击动作 
    ) 
;--<--<-对话框初始化完成-<--<-- 
    (setq Dialog_Return (start_dialog));开启对话框(用 
 
户可见) 
  ) 
  (unload_dialog dcl_id);退出时卸载对话框 
  (princ);防止函数回显 
) 
 
(defun Action_Form1_Keys (key value) ;全部控件的点击动作触发 
  (cond 
    ((= key "accept") ;{确认按钮} 
       
      (Get_Form1_Data) 
      (done_dialog 1);对话框退出返回主函数 传递 
 
给Dialog_Return值为1 
    ) 
    ((= key "cancel") ;{取消按钮} 
       
      (done_dialog 0);对话框退出返回主函数 传递 
 
给Dialog_Return值为0 
    ) 
    ((= key "Command1") ; {"Command1"} (按钮) 
      (c:eww) 
    ) 
  ) 
) 
(defun Get_Form1_Data( / key);临时生成Dcl文件 返回文件名 
  (foreach key keys 
    (set (read (strcat key "_bak")) (get_tile key));每 
 
个控件都赋给一个变量 用于下次开启初始化 
  ) 
) 
(defun Write_Dcl_Form1( / Dcl_File file str) 
  (setq Dcl_File (vl-filename-mktemp nil nil ".Dcl")) 
  (setq file (open Dcl_File "w")) 
  (foreach str '( 
    "Form1:dialog" 
    "{" 
    " label = \"Form1\";" 
    "    :row" 
    "    {" 
    "        :button" 
    "        {" 
    "            key = \"Command1\" ;" 
    "            label = \"Command1\" ;" 
    "            width = 26.55 ;" 
    "            height = 5.475 ;" 
    "        }" 
    "        :text" 
    "        {" 
    "            key = \"Label1\" ;" 
    "            width = 48.15 ;" 
    "            height = 6.075 ;" 
    "        }" 
    "    }" 
    "ok_cancel ;" 
    "}" 
    ) 
    (write-line str file) 
  ) 
  (close file) 
  Dcl_File 
) 
;| 
/*   自动备份FRM文件内容 
VERSION 5.00 
Begin VB.Form Form1 
   Caption         =   "Form1" 
   ClientHeight    =   6450 
   ClientLeft      =   120 
   ClientTop       =   450 
   ClientWidth     =   9675 
   LinkTopic       =   "Form1" 
   ScaleHeight     =   6450 
   ScaleWidth      =   9675 
   StartUpPosition =   3  '窗口缺省 
   Begin VB.CommandButton Command1 
      Caption         =   "Command1" 
      Height          =   1095 
      Left            =   1080 
      TabIndex        =   0 
      Top             =   960 
      Width           =   2655 
   End 
   Begin VB.Label Label1 
      Caption         =   "Label1" 
      Height          =   1215 
      Left            =   4200 
      TabIndex        =   1 
      Top             =   1200 
      Width           =   4815 
   End 
End 
Attribute VB_Name = "Form1" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = False 
Attribute VB_PredeclaredId = True 
Attribute VB_Exposed = False 
*/ 
|; 
 
 
 
(defun c:eww(/ x0 y0 x1 y1) 
 (gxl-error-init1 (list ‘blipmode 0 ‘cmdecho 0 ‘osmode 0) ‘tt1 
 
2) ;_ 出错只编组 
  (defun tt1 ()  ;_ 出错后*error*要执行的动作 
    (alert "出错啦！") 
    ) 
(setvar "cmdecho" 0 ) 
   
(SetQ        p0 (GetPoint "\n 第一角点：") x0(car p0) y0(cadr p0) 
        p1 (getcorner p0 "\n 另一角点：") x1(car p1) y1(cadr p1) 
        dx (abs (- x0 x1)) 
        dy (abs (- y0 y1)) 
) 
(Command "rectang" p0 p1) 
 
(if(<= dx dy) 
(SetQ al (/ dx 8)) 
(SetQ al (/ dy 8))) 
(Command "revcloud" "a" al al "s" "c" "o" "l" "") 
   
(setvar "cmdecho" 1) 
(gxl-error-end) 
(prinC) 
)

鲑鱼扬帆 · 发表于 2014-8-15 16:48:10

为什么加载以后点command1按钮调不出我自己写的eww这个命令呢 Cad卡死了直接

鲑鱼扬帆 · 发表于 2014-8-15 16:51:20

或者说怎样调用我写的eww命令呢

xyp1964 · 发表于 2014-8-15 19:26:08

(defun c:tt (/ ddr)
(vl-load-com)
(setq dcl_file (write_dcl_form1)
dcl_id (load_dialog dcl_file)
dr 2
) ;对话框加载
(vl-file-delete dcl_file) ;加载后删除dcl文件
(while (> dr 1) ;循环控制对话框是否结束
(new_dialog "form1" dcl_id) ;建立窗体
(setq keys '("command1" "accept" "cancel")) ;列表全部控件名称
(foreach key keys ;全部控件的初始化
(if (eval (read (strcat key "_bak")))
(set_tile key (eval (read (strcat key "_bak"))))
)
(action_tile key "(action_form1_keys $key $value)") ;点击动作
)
(setq dr (start_dialog))
)
(unload_dialog dcl_id)
(if ddr
(c:eww)
)
(princ)
)
(defun action_form1_keys (key value) ;全部控件的点击动作触发
(cond ((= key "accept") ;{确认按钮}
(get_form1_data)
(done_dialog 1) ;对话框退出返回主函数传递给dr值为1
)
((= key "cancel") ;{取消按钮}
(done_dialog 0) ;对话框退出返回主函数传递给dr值为0
)
((= key "command1")
(setq ddr (done_dialog 1))
)
)
)
(defun get_form1_data (/ key) ;临时生成dcl文件返回文件名
(foreach key keys
(set (read (strcat key "_bak")) (get_tile key)) ;每个控件都赋给一个变量用于下次开启初始化
)
)
(defun write_dcl_form1 (/ dcl_file file str)
(setq dcl_file (vl-filename-mktemp nil nil ".dcl")
file (open dcl_file "w")
)
(foreach str '("form1:dialog{label="form1";:row"
"{:button{key="command1";label="command1";width=26.55;height=5.475;}:text{key="label1";width=48.15;height=6.075;}}"
"ok_cancel;"
"}"
)
(write-line str file)
)
(close file)
dcl_file
)
(defun c:eww ()
(if (and (setq p0 (getpoint "\n第一角点: "))
(setq p1 (getcorner p0 "\n另一角点: "))
)
(progn
(setq dx (abs (- (car p0) (car p1)))
dy (abs (- (cadr p0) (cadr p1)))
al (if (<= dx dy)
(/ dx df 1.)
(/ dy df 1.)
)
)
(command "rectang" "non" p0 "non" p1)
(command "revcloud" "a" al al "o" "l" "")
)
)
(princ)
)

(defun c:tt (/ ddr) 
  (vl-load-com) 
  (setq        dcl_file (write_dcl_form1) 
        dcl_id         (load_dialog dcl_file) 
        dr         2 
  )                                        ;对话框加载 
  (vl-file-delete dcl_file)                ;加载后删除dcl文件 
  (while (> dr 1)                        ;循环控制对话框是否结束 
    (new_dialog "form1" dcl_id)                ;建立窗体 
    (setq keys '("command1" "accept" "cancel")) ;列表全部控件名称 
    (foreach key keys                        ;全部控件的初始化 
      (if (eval (read (strcat key "_bak"))) 
        (set_tile key (eval (read (strcat key "_bak")))) 
      ) 
      (action_tile key "(action_form1_keys $key $value)") ;点击动作 
    ) 
    (setq dr (start_dialog)) 
  ) 
  (unload_dialog dcl_id) 
  (if ddr 
    (c:eww) 
  ) 
  (princ) 
) 
 
(defun action_form1_keys (key value)        ;全部控件的点击动作触发 
  (cond        ((= key "accept")                ;{确认按钮} 
         (get_form1_data) 
         (done_dialog 1)                ;对话框退出返回主函数 传递给dr值为1 
        ) 
        ((= key "cancel")                ;{取消按钮} 
         (done_dialog 0)                ;对话框退出返回主函数 传递给dr值为0 
        ) 
        ((= key "command1") 
         (setq ddr (done_dialog 1)) 
        ) 
  ) 
) 
(defun get_form1_data (/ key)                ;临时生成dcl文件 返回文件名 
  (foreach key keys 
    (set (read (strcat key "_bak")) (get_tile key)) ;每个控件都赋给一个变量 用于下次开启初始化 
  ) 
) 
(defun write_dcl_form1 (/ dcl_file file str) 
  (setq        dcl_file (vl-filename-mktemp nil nil ".dcl") 
        file         (open dcl_file "w") 
  ) 
  (foreach str '("form1:dialog{label="form1";:row" 
                 "{:button{key="command1";label="command1";width=26.55;height=5.475;}:text{key="label1";width=48.15;height=6.075;}}" 
                 "ok_cancel;" 
                 "}" 
                ) 
    (write-line str file) 
  ) 
  (close file) 
  dcl_file 
) 
 
(defun c:eww () 
  (if (and (setq p0 (getpoint "\n第一角点: ")) 
           (setq p1 (getcorner p0 "\n另一角点: ")) 
      ) 
    (progn 
      (setq dx (abs (- (car p0) (car p1))) 
            dy (abs (- (cadr p0) (cadr p1))) 
            al (if (<= dx dy) 
                 (/ dx df 1.) 
                 (/ dy df 1.) 
               ) 
      ) 
      (command "rectang" "non" p0 "non" p1) 
      (command "revcloud" "a" al al "o" "l" "") 
    ) 
  ) 
  (princ) 
)

xyp1964 · 发表于 2014-8-15 19:26:49

简化模式：

;; 需要e派工具箱(XCAD)的支持
(defun c:tt (/ ilst)
(xyp-cmdla0)
(defun main-pro () (c:eww))
(xyp-initSet '(df) '(8))
(setq ilst '(("df" "等分" "int" "8")))
(if (= (xyp-Dcl-Init Ilst "【DCL测试】" t) 1)
(main-pro)
)
(xyp-cmdla1)
)
(defun c:eww ()
(if (and (setq p0 (getpoint "\n第一角点: "))
(setq p1 (getcorner p0 "\n另一角点: "))
)
(progn
(setq dx (abs (- (car p0) (car p1)))
dy (abs (- (cadr p0) (cadr p1)))
al (if (<= dx dy)
(/ dx df 1.)
(/ dy df 1.)
)
)
(command "rectang" "non" p0 "non" p1)
(command "revcloud" "a" al al "o" "l" "")
)
)
(princ)
)

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

[已解答] 大侠帮忙看看这个dcl触发按钮动作哪里错了？

点评

评分