图层创建:MLay

dokey

发现在CAD2010版 -LAYER有个参数"D"可以对图层进行创建说明,因此制作的这个函数,本函数也实现此功能可满足无"D"参数的CAD版创建图层说明

但此函数未实现在"新视口冻结"的功能,请教高手补充

2. ;;图层创建
   
3. ;;命令(MLay "1.图层名" "2.颜色" "3.线型" "4.线宽" "5.注释说明" "6.是否打印y/n" "7.是否冻结y/n" "8.是否当前图层y/n")
   
4. 
   
5. (defun c:TE ()
   
6.         (setvar "cmdecho" 0)
   
7.         (setq clay (getvar "clayer"))
   
8.         (setq osm (getvar "osmode"))
   
9. 
   
10.         (MLay "TEST" "2" "ACAD_ISO02W100" "" "测试说明" "y" "" "Y")
    
11. 
    
12.         (MLay "AXIS" "4" "Border" "0.25" "轴网标注" "" "y" "N")
    
13. 
    
14.         (MLay "Wall" "7" "continuous" "0.13" "建筑墙体" "N" "n" "")
    
15. 
    
16.         (MLay "Start" "" "" "" "" "" "n" "")
    
17. 
    
18.         (setq p1 (getpoint "\n请选择矩形的起点:"))
    
19.         (setq p2 (getcorner p1 "\n请选择矩形的对角点:"))
    
20.         (command "RECTANG" p1 p2)
    
21. 
    
22.         (command "layer" "set" clay "")
    
23.         (setvar "osmode" osm)
    
24.         (princ)
    
25. )
    
26. 
    
27. (defun MLay (LayName LayColor LType LWidth LDesc IsPrn IsFreze IsCur / clay osm slayname)
    
28.         (VL-LOAD-COM)
    
29.         (setq AcadObject (vlax-get-acad-object)
    
30.          AcadDocument (vla-get-ActiveDocument Acadobject)        ;;取得激活的文件
    
31.          mSpace (vla-get-ModelSpace Acaddocument)                     ;;在图纸与模型之间切换
    
32.           AcadLays (vla-get-Layers AcadDocument)                         ;;取得文件图层集
    
33.           AcadLineTypes (vla-get-linetypes Acaddocument)              ;;取得线型
    
34.         )
    
35.         ;;====== 创建图层内容 ======
    
36.         ;;设定:1.图名
    
37.         (setq slayname (vla-add AcadLays LayName))
    
38.         ;;设定:2.颜色
    
39.         (if (= "" LayColor)
    
40.                 (vla-put-Color slayname 7)
    
41.                 (vla-put-Color slayname (atoi LayColor))
    
42.         )
    
43.         ;;设定:3.线型
    
44.         (if (= "" LType)
    
45.                 (vla-put-linetype slayname "Continuous")
    
46.                 (if (or (vl-catch-all-apply 'vla-load (list AcadLineTypes LType "acadiso.lin"))        ;;在线形文件中判断是否有指定线型并加载
    
47.                                   (vl-catch-all-apply 'vla-load (list AcadLineTypes LType "acad.lin"))   ;;在线形文件中判断是否有指定线型并加载
    
48.                          )
    
49.                         (vla-put-linetype slayname LType)
    
50.                         (vla-put-linetype slayname "Continuous")
    
51.                 );;end if OR
    
52.         )
    
53.         ;;设定:4.线宽
    
54.         (if (= "" LWidth)
    
55.                 (vla-put-lineweight slayname -3)
    
56.                 (vla-put-lineweight slayname (* (atof LWidth) 100))
    
57.         )
    
58.         ;;设定:5.线型注释说明
    
59.         (vla-put-Description slayname LDesc)
    
60.         ;;设定:6.是否可打印
    
61.         (if (or (= "" IsPrn)(= "y" IsPrn)(= "Y" IsPrn))
    
62.                 (vla-put-Plottable slayname :vlax-true)
    
63.                 (vla-put-Plottable slayname :vlax-false)
    
64.         )
    
65.         ;;设定:7.是否冻结
    
66.         (if (or (= "y" IsFreze)(= "Y" IsFreze))
    
67.                 (vla-put-Freeze slayname :vlax-true)
    
68.                 (vla-put-Freeze slayname :vlax-false)
    
69.         )
    
70.         ;;设定:8.是否当前图层
    
71.         (if (or (= "y" IsCur)(= "Y" IsCur))
    
72.                 (command "clayer" LayName)
    
73.         )
    
74. 
    
75. )
    
76. 
    
77. 
    

;;图层创建<br /> ;;命令(MLay "1.图层名" "2.颜色" "3.线型" "4.线宽" "5.注释说明" "6.是否打印y/n" "7.是否冻结y/n" "8.是否当前图层y/n")<br /> <br /> (defun c:TE ()<br />         (setvar "cmdecho" 0)<br />         (setq clay (getvar "clayer"))<br />         (setq osm (getvar "osmode"))<br /> <br />         (MLay "TEST" "2" "ACAD_ISO02W100" "" "测试说明" "y" "" "Y")<br /> <br />         (MLay "AXIS" "4" "Border" "0.25" "轴网标注" "" "y" "N")<br /> <br />         (MLay "Wall" "7" "continuous" "0.13" "建筑墙体" "N" "n" "")<br /> <br />         (MLay "Start" "" "" "" "" "" "n" "")<br /> <br />         (setq p1 (getpoint "\n请选择矩形的起点:"))<br />         (setq p2 (getcorner p1 "\n请选择矩形的对角点:"))<br />         (command "RECTANG" p1 p2)<br /> <br />         (command "layer" "set" clay "")<br />         (setvar "osmode" osm)<br />         (princ)<br /> )<br /> <br /> (defun MLay (LayName LayColor LType LWidth LDesc IsPrn IsFreze IsCur / clay osm slayname)<br />         (VL-LOAD-COM)<br />         (setq AcadObject (vlax-get-acad-object)<br />          AcadDocument (vla-get-ActiveDocument Acadobject)        ;;取得激活的文件<br />          mSpace (vla-get-ModelSpace Acaddocument)                     ;;在图纸与模型之间切换<br />           AcadLays (vla-get-Layers AcadDocument)                         ;;取得文件图层集<br />           AcadLineTypes (vla-get-linetypes Acaddocument)              ;;取得线型<br />         )<br />         ;;====== 创建图层内容 ======<br />         ;;设定:1.图名<br />         (setq slayname (vla-add AcadLays LayName))<br />         ;;设定:2.颜色<br />         (if (= "" LayColor)<br />                 (vla-put-Color slayname 7)<br />                 (vla-put-Color slayname (atoi LayColor))<br />         )<br />         ;;设定:3.线型<br />         (if (= "" LType)<br />                 (vla-put-linetype slayname "Continuous")<br />                 (if (or (vl-catch-all-apply 'vla-load (list AcadLineTypes LType "acadiso.lin"))        ;;在线形文件中判断是否有指定线型并加载<br />                                   (vl-catch-all-apply 'vla-load (list AcadLineTypes LType "acad.lin"))   ;;在线形文件中判断是否有指定线型并加载<br />                          )<br />                         (vla-put-linetype slayname LType)<br />                         (vla-put-linetype slayname "Continuous")<br />                 );;end if OR<br />         )<br />         ;;设定:4.线宽<br />         (if (= "" LWidth)<br />                 (vla-put-lineweight slayname -3)<br />                 (vla-put-lineweight slayname (* (atof LWidth) 100))<br />         )<br />         ;;设定:5.线型注释说明<br />         (vla-put-Description slayname LDesc)<br />         ;;设定:6.是否可打印<br />         (if (or (= "" IsPrn)(= "y" IsPrn)(= "Y" IsPrn))<br />                 (vla-put-Plottable slayname :vlax-true)<br />                 (vla-put-Plottable slayname :vlax-false)<br />         )<br />         ;;设定:7.是否冻结<br />         (if (or (= "y" IsFreze)(= "Y" IsFreze))<br />                 (vla-put-Freeze slayname :vlax-true)<br />                 (vla-put-Freeze slayname :vlax-false)<br />         )<br />         ;;设定:8.是否当前图层<br />         (if (or (= "y" IsCur)(= "Y" IsCur))<br />                 (command "clayer" LayName)<br />         )<br /> <br /> )<br /> <br /> <br />