明经上的一个面板修改

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

请哪位老师帮我稍微调一下哇，我这个面板不懂，谢谢！

;; 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

本帖最后由 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

(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

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

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

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

上面改好了

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

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

谢谢老师，麻烦你了

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

旁观学习学习

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

本帖最后由 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

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数字加大就可以

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

[提问] 明经上的一个面板修改

最佳答案

本帖子中包含更多资源

本帖子中包含更多资源

本帖子中包含更多资源