创建图层_CAD中文技术交流网

创建图层

本帖最后由 dcl1214 于 2024-11-29 13:00 编辑

既能创建图层，还能修改图层

(defun $chuang-jian-tu-ceng$ (LayName LayColor LType
LWidth LDesc IsPrn
IsFreze IsCur lst /
acaddocument acadlays
acadlinetypes acadobject
clay mspace osm
slayname
)
;;图层创建,创建图层
;;命令($chuang-jian-tu-ceng$ "1.图层名" "2.颜色" "3.线型" "4.线宽" "5.注释说明" "6.是否打印y/n" "7.是否冻结y/n" "8.是否当前图层y/n" nil)
(setq AcadObject (vlax-get-acad-object)
AcadDocument (vla-get-ActiveDocument Acadobject)
;;取得激活的文件
mSpace (vla-get-ModelSpace Acaddocument)
;;在图纸与模型之间切换
AcadLays (vla-get-Layers AcadDocument)
;;取得文件图层集
AcadLineTypes (vla-get-linetypes Acaddocument)
;;取得线型
)
(setq slayname (vl-catch-all-apply 'vla-add (LIST AcadLays LayName)))
(if (vl-catch-all-error-p slayname)
(setq
slayname
(vl-catch-all-apply
'vla-item
(list (vl-catch-all-apply 'vla-get-Layers (list AcadLays))
LayName
)
)
)
)
(if (vl-catch-all-error-p slayname)
(setq slayname nil)
)
(if (= "" LayColor)
(vl-catch-all-apply 'vla-put-Color (LIST slayname 7))
(vl-catch-all-apply
'vla-put-Color
(LIST slayname (vl-catch-all-apply 'atoi (LIST LayColor)))
)
)
;;设定:2.颜色
(if (= "" LType)
(vl-catch-all-apply
'vla-put-linetype
(LIST slayname "Continuous")
)
(if (not (vl-catch-all-error-p
(vl-catch-all-apply 'tblobjname (list "LTYPE" LType))
)
)
(vl-catch-all-apply 'vla-put-linetype (LIST slayname LType))
;下面的if整段代码在机械版cad会报错，不知道咋回事
(if (or (vl-catch-all-apply
'vla-load
(list AcadLineTypes LType "acadiso.lin")
)
;;在线形文件acadiso.lin中判断是否有指定线型并加载
(vl-catch-all-apply
'vla-load
(list AcadLineTypes LType "acad.lin")
)
;;在线形文件acad.lin中判断是否有指定线型并加载
)
(vl-catch-all-apply 'vla-put-linetype (LIST slayname LType))
(vl-catch-all-apply
'vla-put-linetype
(LIST slayname "Continuous")
)
)
)
)
;;设定:3.线型
(if (= "" LWidth)
(vl-catch-all-apply 'vla-put-lineweight (LIST slayname -3))
(vl-catch-all-apply
'vla-put-lineweight
(LIST slayname
(vl-catch-all-apply
'*
(LIST (vl-catch-all-apply 'atof (LIST LWidth)) 100)
)
)
)
)
;;设定:4.线宽
(vl-catch-all-apply
'vla-put-Description
(LIST slayname LDesc)
)
;;设定:5.线型注释说明
(if (or (= "" IsPrn) (= "y" IsPrn) (= "Y" IsPrn))
(vl-catch-all-apply
'vla-put-Plottable
(LIST slayname :vlax-true)
)
(vl-catch-all-apply
'vla-put-Plottable
(LIST slayname :vlax-false)
)
)
;;设定:6.是否可打印
(if (or (= "y" IsFreze) (= "Y" IsFreze))
(vl-catch-all-apply
'vla-put-Freeze
(LIST slayname :vlax-true)
)
(vl-catch-all-apply
'vla-put-Freeze
(LIST slayname :vlax-false)
)
)
;;设定:7.是否冻结
(if (or (= "y" IsCur) (= "Y" IsCur))
(VL-CATCH-ALL-APPLY 'SETVAR (LIST "clayer" LayName))
)
;;设定:8.是否当前图层
(VL-CATCH-ALL-APPLY 'TBLSEARCH (LIST "LAYER" LayName))
)

(defun $chuang-jian-tu-ceng$ (LayName    LayColor    LType 
            LWidth    LDesc        IsPrn 
            IsFreze    IsCur    lst    / 
            acaddocument        acadlays 
            acadlinetypes        acadobject 
            clay    mspace      osm 
            slayname 
           ) 
  ;;图层创建,创建图层 
  ;;命令($chuang-jian-tu-ceng$ "1.图层名" "2.颜色" "3.线型" "4.线宽" "5.注释说明" "6.是否打印y/n" "7.是否冻结y/n" "8.是否当前图层y/n" nil) 
  (setq  AcadObject    (vlax-get-acad-object) 
  AcadDocument  (vla-get-ActiveDocument Acadobject) 
  ;;取得激活的文件 
  mSpace        (vla-get-ModelSpace Acaddocument) 
  ;;在图纸与模型之间切换 
  AcadLays      (vla-get-Layers AcadDocument) 
  ;;取得文件图层集 
  AcadLineTypes (vla-get-linetypes Acaddocument) 
          ;;取得线型 
  ) 
  (setq slayname (vl-catch-all-apply 'vla-add (LIST AcadLays LayName))) 
  (if (vl-catch-all-error-p slayname) 
    (setq 
      slayname 
       (vl-catch-all-apply 
   'vla-item 
   (list (vl-catch-all-apply 'vla-get-Layers (list AcadLays)) 
         LayName 
   ) 
       ) 
    ) 
  ) 
  (if (vl-catch-all-error-p slayname) 
    (setq slayname nil) 
  ) 
  (if (= "" LayColor) 
    (vl-catch-all-apply 'vla-put-Color (LIST slayname 7)) 
    (vl-catch-all-apply 
      'vla-put-Color 
      (LIST slayname (vl-catch-all-apply 'atoi (LIST LayColor))) 
    ) 
  ) 
  ;;设定:2.颜色 
 
  (if (= "" LType) 
    (vl-catch-all-apply 
      'vla-put-linetype 
      (LIST slayname "Continuous") 
    ) 
    (if  (not (vl-catch-all-error-p 
         (vl-catch-all-apply 'tblobjname (list "LTYPE" LType)) 
       ) 
  ) 
      (vl-catch-all-apply 'vla-put-linetype (LIST slayname LType)) 
          ;下面的if整段代码在机械版cad会报错，不知道咋回事 
      (if (or (vl-catch-all-apply 
    'vla-load 
    (list AcadLineTypes LType "acadiso.lin") 
        ) 
        ;;在线形文件acadiso.lin中判断是否有指定线型并加载 
        (vl-catch-all-apply 
    'vla-load 
    (list AcadLineTypes LType "acad.lin") 
        ) 
        ;;在线形文件acad.lin中判断是否有指定线型并加载 
    ) 
  (vl-catch-all-apply 'vla-put-linetype (LIST slayname LType)) 
  (vl-catch-all-apply 
    'vla-put-linetype 
    (LIST slayname "Continuous") 
  ) 
      ) 
    ) 
  ) 
  ;;设定:3.线型 
 
  (if (= "" LWidth) 
    (vl-catch-all-apply 'vla-put-lineweight (LIST slayname -3)) 
    (vl-catch-all-apply 
      'vla-put-lineweight 
      (LIST slayname 
      (vl-catch-all-apply 
        '* 
        (LIST (vl-catch-all-apply 'atof (LIST LWidth)) 100) 
      ) 
      ) 
    ) 
  ) 
  ;;设定:4.线宽 
  (vl-catch-all-apply 
    'vla-put-Description 
    (LIST slayname LDesc) 
  ) 
  ;;设定:5.线型注释说明 
 
  (if (or (= "" IsPrn) (= "y" IsPrn) (= "Y" IsPrn)) 
    (vl-catch-all-apply 
      'vla-put-Plottable 
      (LIST slayname :vlax-true) 
    ) 
    (vl-catch-all-apply 
      'vla-put-Plottable 
      (LIST slayname :vlax-false) 
    ) 
  ) 
  ;;设定:6.是否可打印 
 
  (if (or (= "y" IsFreze) (= "Y" IsFreze)) 
    (vl-catch-all-apply 
      'vla-put-Freeze 
      (LIST slayname :vlax-true) 
    ) 
    (vl-catch-all-apply 
      'vla-put-Freeze 
      (LIST slayname :vlax-false) 
    ) 
  ) 
  ;;设定:7.是否冻结       
  (if (or (= "y" IsCur) (= "Y" IsCur)) 
    (VL-CATCH-ALL-APPLY 'SETVAR (LIST "clayer" LayName)) 
  ) 
  ;;设定:8.是否当前图层 
  (VL-CATCH-ALL-APPLY 'TBLSEARCH (LIST "LAYER" LayName)) 
)

网友答: 一行command "layer" "_new" ...能干的事，搞出100多行代码。

网友答: dear sir,
nice thanks for sharing
can possible add FLITER group function ...??

网友答: 有点复杂...

网友答: 学习下，谢谢

网友答: 好像没有透明度设置

网友答:
谢谢分享，存起来备用，谢过啦

网友答:

kozmosovia 发表于 2024-11-29 16:35
一行command "layer" "_new" ...能干的事，搞出100多行代码。

扎心了,老铁

网友答: 现在图纸都用PDF打印，图纸开始向彩色过度，新建图层的颜色能支持真彩色就更好

上一篇：(vlax-invoke obj 'intersectwith obj acextendnone)返回结果各

下一篇：没有了