njut_prince 发表于 2013-4-7 19:20:44

【求助】请高手帮忙加一个对话框

本帖最后由 njut_prince 于 2013-4-7 19:34 编辑

这个是一个批量新建图层的源码，请高手加一个对话框，可以选择要新建哪几个图层（支持多选），谢谢！
因为如果图层比较多的话不是每次都要用到所以的图层，希望新建需要用到的图层！*(源码里面的图层是可以修改增加的)

;;一次性建立多个层
(DEFUN c:tttt (/ lt lst)
(DEFUN mklacolt (lay col lt / chk_lay)
    (if (= (tblsearch "layer" lay) nil)
      (command "layer" "new" lay "c" col lay "lt" lt lay "")
    )
)
(setvar "cmdecho" 0)
(foreach lt '("CENTER" "HIDDEN" "DASHED" "phantom")
    (if (= (tblsearch "ltype" lt) nil)
      (command "_linetype" "l" lt "" "")
    )
)
(foreach lst '(
   ("剖面线层" 40 "CONTINUOUS")
   ("中心线层" 1 "CENTER")
   ("短虚线层" 3 "HIDDEN")
   ("长虚线层" 6 "DASHED")
   ("细实线层" 2 "CONTINUOUS")
   ("尺寸线层" 4 "Continuous")
   ("流道层" 2 "CONTINUOUS")
   ("线切割层" 2 "CONTINUOUS")
   ("文字层" 6 "CONTINUOUS")
   ("顶出板层" 132 "HIDDEN")
   ("顶针平面层" 7 "CONTINUOUS")
)
    (mklacolt (car lst) (cadr lst) (caddr lst))
)
(PROMPT "\n新图层已建立")
(princ)
)

smartstar 发表于 2013-4-7 20:55:57

楼主可以试试这个http://bbs.mjtd.com/thread-96286-1-1.html

njut_prince 发表于 2013-4-8 18:47:33

楼上的还是不能满足要求哦，我想要的是能选择要新建的图层。。。

ZZXXQQ 发表于 2013-4-9 09:49:27

试下看

dcl_settings:default_dcl_settings{audit_level=3;}
layers:dialog{
label="图层建立";
:list_box{label="名称";key="lname";width=18;multiple_select=true;value="0";}
ok_cancel;
}


;;一次性建立多个层
(defun c:tttt (/ lt lst)
(defun mklacolt (lay col lt / chk_lay)
(if (= (tblsearch "layer" lay) nil)
   (command "layer" "new" lay "c" col lay "lt" lt lay "")
)
)
(defun readata ()
(if (> (length (setq nn (read(strcat "(" (get_tile "lname") ")")))) 0)
   (setq lst (mapcar '(lambda(a) (nth a llst)) nn))
)
)
(setvar "cmdecho" 0)
(foreach lt '("CENTER" "HIDDEN" "DASHED" "phantom")
(if (= (tblsearch "ltype" lt) nil)
   (command "_linetype" "l" lt "" "")
)
)
(setq lst (list))
(setq llst   '(
   ("剖面线层" 40 "CONTINUOUS")
   ("中心线层" 1 "CENTER")
   ("短虚线层" 3 "HIDDEN")
   ("长虚线层" 6 "DASHED")
   ("细实线层" 2 "CONTINUOUS")
   ("尺寸线层" 4 "Continuous")
   ("流道层" 2 "CONTINUOUS")
   ("线切割层" 2 "CONTINUOUS")
   ("文字层" 6 "CONTINUOUS")
   ("顶出板层" 132 "HIDDEN")
   ("顶针平面层" 7 "CONTINUOUS")
)
)
(if (> (setq dcl_id (load_dialog "layers.dcl")) 0) (progn
(if (new_dialog "layers" dcl_id) (progn
   (start_list "lname")
   (mapcar'(lambda (a) (add_list (car a))) llst)
   (end_list)
   (action_tile "accept" "(readata) (done_dialog 1)")
   (action_tile "cancel" "(done_dialog 0)")
   (setq re (start_dialog))
)
   (princ "\n无法显示对话框！")
)
(unload_dialog dcl_id)
)
(princ "\n无法加载对话框！")
)
(if (and (= re 1) lst) (progn
(foreach l lst (mklacolt (car l) (cadr l) (caddr l)))
(PROMPT "\n新图层已建立")
))
(princ)
)

sachindkini 发表于 2013-4-9 13:09:03

ZZXXQQ 发表于 2013-4-9 09:49 static/image/common/back.gif
试下看



ommand:TTTT
; error: bad argument type: stringp nil

njut_prince 发表于 2013-4-9 20:31:13

zzxxqq版主的已经满足要求了，最好能像CAD图层管理器里面一样能显示名称、颜色、线型那就完美了   谢谢各位！！！

gulang008 发表于 2014-1-29 09:46:47

还是有一些看不到啊。。

xyp1964 发表于 2014-1-29 13:06:46

;; 一次性建立多个层
;; 需要e派工具箱(XCAD)的支持：http://yunpan.cn/QXQKsW9gAPmpF
(defun c:tt (/ ilst ll1 ll2)
(defun main-pro (/ ss i s1)
    (foreach lt        '("CENTER" "HIDDEN" "DASHED" "phantom")
      (if (= (tblsearch "ltype" lt) nil)
        (command "_linetype" "l" lt "" "")
      )
    )
    (foreach a (mapcar 'atoi (xyp-Get-Str2Lst li1))
      (setq b (nth a lst))
      (XYP-MKLACOLT (car b) (cadr b) (caddr b))
    )
)
(if (or (null li1) (/= (type li1) 'STR))
    (setq li1 "0")
)
(setq        lst'(("剖面线层" 40 "CONTINUOUS")
             ("中心线层" 1 "CENTER")
             ("短虚线层" 3 "HIDDEN")
             ("长虚线层" 6 "DASHED")
             ("细实线层" 2 "CONTINUOUS")
             ("尺寸线层" 4 "Continuous")
             ("流道层" 2 "CONTINUOUS")
             ("线切割层" 2 "CONTINUOUS")
             ("文字层" 6 "CONTINUOUS")
             ("顶出板层" 132 "HIDDEN")
             ("顶针平面层" 7 "CONTINUOUS")
              )
        lst1 (mapcar 'car lst)
        ilst '(("li1" "直径" "list" "lst1" "8" "10"))
)
(if (= (xyp-Dcl-Init Ilst "【建立图层】" t) 1)
    (main-pro)
)
(princ)
)

恕放之生命 发表于 2014-8-6 21:34:39

学习一下。
页: [1]
查看完整版本: 【求助】请高手帮忙加一个对话框