通用按键二维 dcl 通用面板
;通用按键二维面板;
;
(defun BT-UI-BT(tit s / #BT-KS bt-dcl bt-format)
(vl-load-com)
(defun BT-FORMAT (tit s / i str);格式化
(setq i 1)
(append
(list "btbt:button{horizontal_margin = none ;vertical_margin = none ;}";格式化按钮fixed_width = true ;width = 20;
(strcat "BTUI:dialog{label = " (vl-prin1-to-string tit)";");标题
(if(= 'str(type(setq str(car s))))
(progn (setq s(cdr s))(strcat ":boxed_row{label=\""str"\";"))
":row{");如果是字符串
)
(apply 'append
(mapcar
'(lambda(a)
(append
(list
(if (= 'str(type(setq str(car a))))
(progn(setq a(cdr a))(strcat":boxed_column{label=\""str"\";"))
":column{")
;"children_fixed_height=\"true\";"
;"children_alignment=\"top\";"
);如果是字符串
(mapcar
'(lambda(b / c d)
(setq c (strcat ":btbt{label = " (if(=""(car b))"\"\""(vl-prin1-to-string(car b))) " ; key = "(vl-prin1-to-string (strcat "bt" (setq d (itoa (setq i (1+ i))))))";}"))
(setq #BT-KS (append #BT-KS (list(cons d (cadr b)))))
c
)
a
)
(list "}")
)
)
s
)
)
(list "}"
":image{color=2;height=0.2;}"
"ok_only;"
"}"
)
)
)
;;-------------------------------------------------
(defun BT-DCL (tit s / cmd f ff id ui)
(setq f (strcat (getenv "temp") "\\BTBT.DCL"))
(if (findfile f) (vl-file-delete f))
(setq ff (open f "W"))
(foreach x (BT-FORMAT tit s)
(princ (strcat x "\n") ff)
)
(close ff)
(setq ui (load_dialog f))
(if(not(new_dialog "BTUI" ui))(exit))
(foreach x #BT-KS
(action_tile (strcat "bt" (car x))
(strcat "(done_dialog" (car x)")")
)
)
(setq id (start_dialog))
(unload_dialog ui)
(vl-file-delete f)
(if (and (< 1 id)
(setq cmd (assoc (itoa id) #BT-KS))
(setq cmd (cdr cmd))
(= 'str (type cmd))
(read cmd)
)
(vla-SendCommand (vla-get-ActiveDocument(vlax-get-acad-object)) (strcat cmd " "))
;(print(strcat"你调用的命令为：" (if(= ""cmd)"空" cmd)))
)
)
(BT-DCL tit s)
)
;;-------------------------------------------------
(defun c:tt()
(bt-ui-bt "标题" '(
("工具1"("圆""c")("线""l"))
(("标注""dli")("工具4"""))
)
))
;通用按键二维面板,小波简化版2023.1.8
(defun BT-UI-BT(tit s / #BT-KS bt-dcl bt-format)
(defun BT-FORMAT (tit s / i str);格式化
(setq i 1)
(append
(list "btbt:button{horizontal_margin = none ;vertical_margin = none ;}";格式化按钮fixed_width = true ;width = 20;
(strcat "BTUI:dialog{label = " (vl-prin1-to-string tit)";");标题
(if(= 'str(type(setq str(car s))))
(progn (setq s(cdr s))(strcat ":boxed_row{label=\""str"\";"))
":row{");如果是字符串
)
(apply 'append
(mapcar
'(lambda(a)
(append
(list
(if (= 'str(type(setq str(car a))))
(progn(setq a(cdr a))(strcat":boxed_column{label=\""str"\";"))
":column{")
;"children_fixed_height=\"true\";"
;"children_alignment=\"top\";"
);如果是字符串
(mapcar
'(lambda(b / c d)
(setq c (strcat ":btbt{label = " (if(=""(car b))"\"\""(vl-prin1-to-string(car b))) " ; key = "(vl-prin1-to-string (strcat "bt" (setq d (itoa (setq i (1+ i))))))";}"))
(setq #BT-KS (append #BT-KS (list(cons d (cadr b)))))
c
)
a
)
(list "}")
)
)
s
)
)
(list "}"
":image{color=2;height=0.2;}"
"ok_only;"
"}"
)
)
)
;;-------------------------------------------------
(defun BT-DCL (tit s / cmd f ff id ui)
(setq f (strcat (getenv "temp") "\\BTBT.DCL"))
(if (findfile f) (vl-file-delete f))
(setq ff (open f "W"))
(foreach x (BT-FORMAT tit s)
(princ (strcat x "\n") ff)
)
(close ff)
(setq ui (load_dialog f))
(if(not(new_dialog "BTUI" ui))(exit))
(foreach x #BT-KS
(action_tile (strcat "bt" (car x))
(strcat "(done_dialog" (car x)")")
)
)
(setq id (start_dialog))
(unload_dialog ui)
(vl-file-delete f)
(if (and (< 1 id)
(setq cmd (assoc (itoa id) #BT-KS))
(setq cmd (cdr cmd))
(= 'str (type cmd))
(read cmd)
)
(vla-SendCommand (vla-get-ActiveDocument(vlax-get-acad-object)) (strcat cmd " "))
;(print(strcat"你调用的命令为：" (if(= ""cmd)"空" cmd)))
)
)
(BT-DCL tit s)
)
;;-------------------------------------------------
页:
[1]