冒个烟圈 发表于 2015-5-28 08:00:11

老大们请帮忙

此命令提示”\n该图层已存在！"后就自动退出了
要求增加功能：提示”该图层已存在“后，请重新输入图层名

；；来自明经lyqiezi的新建图层                     
(defun c:NL()
      (setq lay_name (getstring "\n输入要新建的图层名称："))
      (if (tblsearch "LAYER"lay_name)
                (princ "\n该图层已存在！")
                (progn
                        (setq lay_cor (abs (cdr(assoc 62 (tblnext"layer" t)))))
                        (setq cor_list nil)
                        (while lay_cor
                              (setq cor_list (vl-list* lay_cor cor_list))
                              (if (setq lay_cor (cdr (assoc 62 (tblnext"layer"))))
                                        (setq lay_cor (abs lay_cor)))
                        )
                        (setq cor 1)
                        (while (member cor cor_list)
                              (setq cor (1+ cor))
                        )
                        (if (> cor 255)
                              (progn
                                        (princ "\n您的图层颜色过多，已按255色建层")
                                  (setq cor 255)))
                        (entmake (list '(0 . "LAYER") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbLayerTableRecord") '(70 . 0) '(6 . "Continuous")(cons 62 cor)
                                        (cons 2 lay_name)
                              )
                        )
                        (command "clayer" lay_name)
                        (princ "\n已新建图层<<")
                  (princ lay_name)
               (princ ">>并切换成当前图层")
                )
               
      )
      (prin1)
)

http://bbs.mjtd.com/xwb/images/bgimg/icon_logo.png 该贴已经同步到 冒个烟圈的微博


http://bbs.mjtd.com/xwb/images/bgimg/icon_logo.png 该贴已经同步到 冒个烟圈的微博

放羊去的 发表于 2015-5-28 08:23:05

(defun c:NL()
      (setq lay_name (getstring "\n输入要新建的图层名称："))
      (if (tblsearch "LAYER"lay_name)
                  (progn
               (princ "\n该图层已存在！")
               (c:NL)
                )
                (progn
                        (setq lay_cor (abs (cdr(assoc 62 (tblnext"layer" t)))))
                        (setq cor_list nil)
                        (while lay_cor
                              (setq cor_list (vl-list* lay_cor cor_list))
                              (if (setq lay_cor (cdr (assoc 62 (tblnext"layer"))))
                                        (setq lay_cor (abs lay_cor)))
                        )
                        (setq cor 1)
                        (while (member cor cor_list)
                              (setq cor (1+ cor))
                        )
                        (if (> cor 255)
                              (progn
                                        (princ "\n您的图层颜色过多，已按255色建层")
                                  (setq cor 255)))
                        (entmake (list '(0 . "LAYER") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbLayerTableRecord") '(70 . 0) '(6 . "Continuous")(cons 62 cor)
                                        (cons 2 lay_name)
                              )
                        )
                        (command "clayer" lay_name)
                        (princ "\n已新建图层<<")
                  (princ lay_name)
               (princ ">>并切换成当前图层")
                )
               
      )
      (prin1)
)

冒个烟圈 发表于 2015-5-28 08:42:12

放羊去的 发表于 2015-5-28 08:23 static/image/common/back.gif


谢谢，，要的就是这个效果

nadaloveluna 发表于 2015-5-28 12:07:01

冒个烟圈 发表于 2015-5-28 08:42 static/image/common/back.gif
谢谢，，要的就是这个效果

新建图层的颜色，线型怎么修改呢，前辈。。。。。

ZZXXQQ 发表于 2015-5-28 13:37:57

(entmake
   (list
    '(0 . "LAYER")
    '(100 . "AcDbSymbolTableRecord")
    '(100 . "AcDbLayerTableRecord")
    '(70 . 0)
    '(6 . "Continuous");线型
    (cons 62 cor);颜色
    (cons 2 lay_name)
   )
)

冒个烟圈 发表于 2015-5-28 19:32:30

nadaloveluna 发表于 2015-5-28 12:07 static/image/common/back.gif
新建图层的颜色，线型怎么修改呢，前辈。。。。。

这个是自动设置颜色的，就是与图形文件中现有的图层颜色不一样，自动选定一种颜色，如果不满意动手改下颜色，至于线型嘛，“ZZXXQQ”前辈的贴子上有标注了。

oistre 发表于 2018-8-30 18:52:19

谢谢大神，牛牛牛牛！！！
页: [1]
查看完整版本: 老大们请帮忙