明经上的一个面板修改

sbwdx 发表于 2019-11-10 18:21:19

请哪位老师帮我稍微调一下哇，我这个面板不懂，谢谢！;; titl:标题; buttons:按钮列表; flag:nil先行后列T先列后行
(defun Dcl-ButtonM (titl buttons flag / a b c)
(defun strsplist (str / i)
(if    (setq i (vl-string-search " " str))
   (list (substr str 1 i)
(vl-string-trim " " (substr str (+ 2 i)))
   )
)
)

(defun makedcl (str_lst / fileID dclHandle)
(setq dclfile (vl-filename-mktemp nil nil ".dcl")
fileID(open dclfile "w")
)
(cond ((= (type str_lst) 'str) (write-line str_lst fileID))
((= (type str_lst) 'list)
(foreach n str_lst (write-line n fileID))
)
)
(close fileID)
(setq dclHandle (load_dialog dclfile))
)
(setq    b (if flag
":column{label = \""
":row{label = \""
)
c (if flag
":row{label = \""
":column{label = \""
)
d '("ESC")
a (strcat (vl-string-translate
"$~"
"AB"
(vl-filename-base (vl-filename-mktemp))
)
":dialog{label=\""
titl
"\";\n"
b
"\";\n"
)
)
(foreach x buttons
(if    (listp x)
   (progn
   (setq a (strcat a c (car x) "\";\n"))
   (foreach y (last x)
      (setq    b (strsplist y)
a (if b
(strcat a
":button {key =\""
(car b)
"\";label=\""
(last b)
"\";}\n"
)
(strcat a "spacer_0;\n")
)
d (if (/= (car b) nil)
(cons (car b) d)
d
)
      )
   )
   (setq a (strcat a "}\n"))
   )
   (setq a (strcat a "spacer_0;\n"))
)
)
(setq    d (cdr (REVERSE d))
a (strcat a
(if flag
":row"
":column"
)
"{spacer_0;:button{key = \"HLP\";label = \"帮助\";}\n"
":button{key=\"ESC\";label=\"取消\";is_cancel = true;}}}}"
)
dcl(makedcl a)
lst1 '()
i 1
)
(foreach key d
(setq tx (strcat "(action_tile \""
key
"\"\"(done_dialog "
(itoa i)
")\")"
)
lst1 (cons tx lst1)
i (1+ i)
)
)
(new_dialog (substr a 1 8) dcl)
(action_tile "ESC" "(done_dialog 0)")
(action_tile "HLP" "(alert\"通用了，还郁闷?\")")
(eval (read (strcat "(progn" (apply 'strcat lst1) ")")))
(setq ctl (start_dialog))
(UNLOAD_DIALOG dcl)
(vl-file-delete dclfile)
(if (/= ctl 0)
(eval (read (strcat "(c:" (nth (- ctl 1) d) ")")))
)
)
(defun c:tt4 (/ lst)
(setq    lst '(
("点状物"
("Y1 雨水、污水井 " "hqzb 获取坐标 " "bjcl 板筋处理 " "dtbj 动态板筋 ")
)
("注筋、标注"
("zjpb 注筋排版 " "zjzz 注筋左置 " "" "zjyw 注筋移位 " "gtcm 改图层名 ")
)
("桩基网架"
("zjct 桩基承台 " "zjtj 桩基统计 " "" "pbwj 平板网架 " "qxhj 曲线桁架 ")
)
("编辑处理"
("glbh 改粱编号 " "lkjd 梁宽校对 " "" "lzxj 梁柱修剪 " "xyp-jzl 井字梁 ")
)
)
)
(Dcl-ButtonM "【XX工具】V2014.1.21" lst nil)
(princ)

)

taoyi0727 发表于 2019-11-10 18:21:20

本帖最后由 taoyi0727 于 2019-11-10 20:14 编辑

(defun Dcl-ButtonM (titl buttons flag / a b c)
(defun strsplist (str / i)
(if (setq i (vl-string-search " " str))
   (list (substr str 1 i)
(vl-string-trim " " (substr str (+ 2 i)))
   )
)
)
(defun makedcl (str_lst / fileID dclHandle)
(setq
dclfile (vl-filename-mktemp nil nil ".dcl")
fileID(open dclfile "w")
)
(cond
((= (type str_lst) 'str)
(write-line str_lst fileID)
)
((= (type str_lst) 'list)
(foreach n str_lst (write-line n fileID))
)
)
(close fileID)
(setq dclHandle (load_dialog dclfile))
)
(setq
b (if flag
":column{label = \""
":row{label = \""
)
c (if flag
":row{label = \""
":column{label = \""
)
d '("ESC")
a (strcat (vl-string-translate
"$~"
"AB"
(vl-filename-base (vl-filename-mktemp))
)
":dialog{label=\""
titl
"\";\n"
b
"\";\n"
)
)
(foreach x buttons
(if (listp x)
   (progn
   (setq a (strcat a c (car x) "\";\n"))
   (foreach y (last x)
      (setq
b (strsplist y)
a (if b
(strcat a
":button {key =\""
(car b)
"\";label=\""
(last b)
"\";}\n"
)
(strcat a "spacer_0;\n")
)
d (if (/= (car b) nil)
(cons (car b) d)
d
)
      )
   )
   (setq a (strcat a "}\n"))
   )
   (setq a (strcat a "spacer_0;\n"))
)
)
(setq
d (cdr (REVERSE d))
a (strcat a
"}"
":text{key=\"str\";label=\"加字加字加字\";}"
":row{"
":spacer { width = 26; } "
":button{key = \"HLP\";label = \"帮助\";}\n"
":button{key=\"ESC\";label=\"取消\";is_cancel = true;}}}"
)
dcl(makedcl a)
lst1 '()
i 1
)
(foreach key d
(setq
tx (strcat "(action_tile \""
key
"\"\"(done_dialog "
(itoa i)
")\")"
)
lst1 (cons tx lst1)
i (1+ i)
)
)
(new_dialog (substr a 1 8) dcl)
(action_tile "ESC" "(done_dialog 0)")
(action_tile "HLP" "(alert\"通用了，还郁闷?\")")
(eval (read (strcat "(progn" (apply 'strcat lst1) ")")))
(setq ctl (start_dialog))
(UNLOAD_DIALOG dcl)
(vl-file-delete dclfile)
(if (/= ctl 0)
(eval (read (strcat "(c:" (nth (- ctl 1) d) ")")))
)
)
(defun c:tt4 (/ lst)
(setq lst '(
("点状物"
("Y1 雨水、污水井 " "hqzb 获取坐标 " "bjcl 板筋处理 " "dtbj 动态板筋 ")
)
("注筋、标注"
("zjpb 注筋排版 " "zjzz 注筋左置 " "" "zjyw 注筋移位 " "gtcm 改图层名 ")
)
("桩基网架"
("zjct 桩基承台 " "zjtj 桩基统计 " "" "pbwj 平板网架 " "qxhj 曲线桁架 ")
)
("编辑处理"
("glbh 改粱编号 " "lkjd 梁宽校对 " "" "lzxj 梁柱修剪 " "xyp-jzl 井字梁 ")
)
)
)
(Dcl-ButtonM "【XX工具】V2014.1.21" lst nil)
(princ)
)

taoyi0727 发表于 2019-11-10 18:45:44

(defun Dcl-ButtonM (titl buttons flag / a b c)
(defun strsplist (str / i)
(if (setq i (vl-string-search " " str))
   (list (substr str 1 i)
(vl-string-trim " " (substr str (+ 2 i)))
   )
)
)
(defun makedcl (str_lst / fileID dclHandle)
(setq
dclfile (vl-filename-mktemp nil nil ".dcl")
fileID(open dclfile "w")
)
(cond
((= (type str_lst) 'str)
(write-line str_lst fileID)
)
((= (type str_lst) 'list)
(foreach n str_lst (write-line n fileID))
)
)
(close fileID)
(setq dclHandle (load_dialog dclfile))
)
(setq
b (if flag
":column{label = \""
":row{label = \""
)
c (if flag
":row{label = \""
":column{label = \""
)
d '("ESC")
a (strcat (vl-string-translate
"$~"
"AB"
(vl-filename-base (vl-filename-mktemp))
)
":dialog{label=\""
titl
"\";\n"
b
"\";\n"
)
)
(foreach x buttons
(if (listp x)
   (progn
   (setq a (strcat a c (car x) "\";\n"))
   (foreach y (last x)
      (setq
b (strsplist y)
a (if b
(strcat a
":button {key =\""
(car b)
"\";label=\""
(last b)
"\";}\n"
)
(strcat a "spacer_0;\n")
)
d (if (/= (car b) nil)
(cons (car b) d)
d
)
      )
   )
   (setq a (strcat a "}\n"))
   )
   (setq a (strcat a "spacer_0;\n"))
)
)
(setq
d (cdr (REVERSE d))
a (strcat a
"}"
":row{"
":text{key=\"str\";label=\"加字加字加字\";}"
":button{key = \"HLP\";label = \"帮助\";}\n"
":button{key=\"ESC\";label=\"取消\";is_cancel = true;}}}"
)
dcl(makedcl a)
lst1 '()
i 1
)
(foreach key d
(setq
tx (strcat "(action_tile \""
key
"\"\"(done_dialog "
(itoa i)
")\")"
)
lst1 (cons tx lst1)
i (1+ i)
)
)
(new_dialog (substr a 1 8) dcl)
(action_tile "ESC" "(done_dialog 0)")
(action_tile "HLP" "(alert\"通用了，还郁闷?\")")
(eval (read (strcat "(progn" (apply 'strcat lst1) ")")))
(setq ctl (start_dialog))
(UNLOAD_DIALOG dcl)
(vl-file-delete dclfile)
(if (/= ctl 0)
(eval (read (strcat "(c:" (nth (- ctl 1) d) ")")))
)
)
(defun c:tt4 (/ lst)
(setq lst '(
("点状物"
("Y1 雨水、污水井 " "hqzb 获取坐标 " "bjcl 板筋处理 " "dtbj 动态板筋 ")
)
("注筋、标注"
("zjpb 注筋排版 " "zjzz 注筋左置 " "" "zjyw 注筋移位 " "gtcm 改图层名 ")
)
("桩基网架"
("zjct 桩基承台 " "zjtj 桩基统计 " "" "pbwj 平板网架 " "qxhj 曲线桁架 ")
)
("编辑处理"
("glbh 改粱编号 " "lkjd 梁宽校对 " "" "lzxj 梁柱修剪 " "xyp-jzl 井字梁 ")
)
)
)
(Dcl-ButtonM "【XX工具】V2014.1.21" lst nil)
(princ)
)

sbwdx 发表于 2019-11-10 18:59:00

taoyi0727 发表于 2019-11-10 18:45
(defun Dcl-ButtonM (titl buttons flag / a b c)
(defun strsplist (str / i)
(if (setq i (vl-st ...

老师你好，位置能低一排吗？

sbwdx 发表于 2019-11-10 20:06:07

taoyi0727 发表于 2019-11-10 19:37
(defun Dcl-ButtonM (titl buttons flag / a b c)
(defun strsplist (str / i)
(if (setq i (vl- ...

老师，下面那排图标太大了，不好看，想弄成这样的格式可以吗？

taoyi0727 发表于 2019-11-10 20:14:48

sbwdx 发表于 2019-11-10 20:06
老师，下面那排图标太大了，不好看，想弄成这样的格式可以吗？

上面改好了

sbwdx 发表于 2019-11-10 20:21:57

taoyi0727 发表于 2019-11-10 20:14
上面改好了

谢谢老师，麻烦你了

mocheng 发表于 2019-11-11 23:58:31

旁观学习学习

sbwdx 发表于 2019-11-12 12:00:20

本帖最后由 sbwdx 于 2019-11-12 12:01 编辑

taoyi0727 发表于 2019-11-10 20:14
上面改好了
老师，还得麻烦你，我使用了一哈，我的字有点长，然后下面的帮助和取消按钮也变长了，就不大好看，可以缩小吗?(defun Dcl-ButtonM (titl buttons flag / a b c)
(defun strsplist (str / i)
(if (setq i (vl-string-search " " str))
   (list (substr str 1 i)
                           (vl-string-trim " " (substr str (+ 2 i)))
   )
            )
)
(defun makedcl (str_lst / fileID dclHandle)
(setq
                     dclfile (vl-filename-mktemp nil nil ".dcl")
                     fileID(open dclfile "w")
)
(cond
                     ((= (type str_lst) 'str)
                           (write-line str_lst fileID)
                     )
                     ((= (type str_lst) 'list)
                           (foreach n str_lst (write-line n fileID))
                     )
            )
            (close fileID)
            (setq dclHandle (load_dialog dclfile))
   )
   (setq
            b (if flag
                           ":column{label = \""
                           ":row{label = \""
                     )
            c (if flag
                           ":row{label = \""
                           ":column{label = \""
                     )
            d '("ESC")
            a (strcat (vl-string-translate
                                                            "$~"
                                                            "AB"
                                                            (vl-filename-base (vl-filename-mktemp))
                                                   )
                           ":dialog{label=\""
                           titl
                           "\";\n"
                           b
                           "\";\n"
                     )
)
(foreach x buttons
(if (listp x)
   (progn
   (setq a (strcat a c (car x) "\";\n"))
   (foreach y (last x)
      (setq
                                             b (strsplist y)
                                             a (if b
                                                            (strcat a
                                                                     ":button {key =\""
                                                                     (car b)
                                                                     "\";label=\""
                                                                     (last b)
                                                                     "\";}\n"
                                                            )
                                                            (strcat a "spacer_0;\n")
                                                   )
                                             d (if (/= (car b) nil)
                                                            (cons (car b) d)
                                                            d
                                                   )
      )
   )
   (setq a (strcat a "}\n"))
   )
   (setq a (strcat a "spacer_0;\n"))
)
)
   (setq
            d (cdr (REVERSE d))
            a (strcat a
                                    "}"
                                    ":text{key=\"str\";label=\"加字加字加字\";}"
                                    ":row{"
                                    ":spacer { width = 26; } "
                                    ":button{key = \"HLP\";label = \"帮助\";}\n"
                                    ":button{key=\"ESC\";label=\"取消\";is_cancel = true;}}}"
                              )
            dcl(makedcl a)
            lst1 '()
            i 1
)
(foreach key d
(setq
                     tx (strcat "(action_tile \""
                                             key
                                             "\"\"(done_dialog "
                                             (itoa i)
                                             ")\")"
                                    )
                     lst1 (cons tx lst1)
                     i (1+ i)
)
)
(new_dialog (substr a 1 8) dcl)
(action_tile "ESC" "(done_dialog 0)")
(action_tile "HLP" "(alert\"通用了，还郁闷?\")")
(eval (read (strcat "(progn" (apply 'strcat lst1) ")")))
(setq ctl (start_dialog))
(UNLOAD_DIALOG dcl)
(vl-file-delete dclfile)
   (if (/= ctl 0)
(eval (read (strcat "(c:" (nth (- ctl 1) d) ")")))
)
)
(defun c:tt4 (/ lst)
(setq    lst '(
("绘图功能"
("DDD 水平垂直标注∣DDD ""ZX 两点中点∣ZX" "FFF 两点等分∣FFF " "SZ 按色选择∣SZ""WW 镜像优化∣WW ""HK 填充开关∣HK ""CV 阵列复制∣CV ""C0 图层颜色随层∣C0" "Q 置为当前图层∣Q ""FF 所选对象最前置∣FF ""BB 所选对象最后置∣BB "" 改颜色∣1-255" )
)
("绘图功能"
("GG 超级解组∣GG ""XX 超级炸块∣XX ""ZG 修改字高∣ZG ""DV 标注对齐∣DV " "DE 标注修剪∣DE " "DBB 设为当前标注∣DBB ""HD 指定填充原点∣HD ""EQ 标注值改均分∣EQ " "RS 标注值改实际尺寸∣RS ""YS 当前图层颜色查询∣YS ""DA 改选择对象线型为DASH，比例为1∣DA ""00 对象图层为0，颜色/线性随块，比例为1∣00 ")
)
("辅助功能"
("HH 水平构造线∣HH " "VV 竖直构造线∣VV ""OO 双向偏移∣OO ""BN 快速做块∣BN " "BBI 块改基点∣BBI ""RB 图块改名∣RB ""HF 绘制焊缝∣HF ""HG 填充捕捉∣HG ""OS 捕捉还原∣OS ""CL 中心线(布局使用)∣CL ""QQQ 将对象放置0层∣QQQ""DEF 将对象放置不可打印层∣DEF")
)
("布局功能"
("SV 锁定视口∣SV " "FV 解锁视口∣FV ""VVS 视口比例∣VVS ""SSV 匹配视图∣SSV " "VQ 对齐视图∣VQ ""` 模布切换∣` ""EE 图层隔离∣EE    ""EEE 图层隔离解除∣EEE""TC 节点剖面填充(需安装源泉)∣TC ""DJ （布局视口）当前图层视口冻结∣DJ ""JD （布局视口）当前图层视口解冻∣JD ""VPI （布局视口）其他视口图层冻结∣VPI ")
                     )

)
)
(Dcl-ButtonM "【XX工具】V2014.1.21" lst nil)
   (princ)
)

taoyi0727 发表于 2019-11-12 12:11:02

sbwdx 发表于 2019-11-12 12:00
老师，还得麻烦你，我使用了一哈，我的字有点长，然后下面的帮助和取消按钮也变长了，就不大好看，可以缩 ...

"}"
":text{key=\"str\";label=\"加字加字加字\";}"
":row{"
":spacer { width = 26; } "
":button{key = \"HLP\";label = \"帮助\";}\n"
":button{key=\"ESC\";label=\"取消\";is_cancel = true;}}}"

把上面的26数字加大就可以

页: [1] 2

明经CAD社区's Archiver

明经上的一个面板修改