大侠帮忙看看这个dcl触发按钮动作哪里错了？
(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)
)
为什么加载以后点command1按钮调不出我自己写的eww这个命令呢 Cad卡死了直接 或者说怎样调用我写的eww命令呢 (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)
)
简化模式：;; 需要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)
)
页:
[1]