AutoCAD VBA基于对象的分层
2011-03-22 22:23 精诚所至 金石为开 阅读(598) 评论(0) 编辑 收藏 举报AutoCAD VBA基于对象的分层,讲不同对象根据特性分层,代码如下。
Dim Value As Variant
Value = ThisDrawing.GetVariable("cmdecho")
ThisDrawing.SetVariable "cmdecho", 0
Dim ObjLayer As AcadLayer
Set ObjLayer = ThisDrawing.Layers.Add("尺寸标注")
Set ObjLayer = ThisDrawing.Layers.Add("文字")
Set ObjLayer = ThisDrawing.Layers.Add("主体")
Set ObjLayer = ThisDrawing.Layers.Add("图案填充")
Set ObjLayer = ThisDrawing.Layers.Add("虚线")
Set ObjLayer = ThisDrawing.Layers.Add("中心线")
Set ObjLayer = ThisDrawing.Layers.Add("剖面线")
Set ObjLayer = ThisDrawing.Layers.Add("隐藏线")
Dim ObjSelectionSet As AcadSelectionSet
Dim Count As Integer
Count = ThisDrawing.SelectionSets.Count
While (Count > 0)
Set ObjSelectionSet = ThisDrawing.SelectionSets.Item(Count - 1)
ObjSelectionSet.Delete
Count = Count - 1
Wend
Set ObjSelectionSet = ThisDrawing.SelectionSets.Add("SSET")
Dim gpCode() As Integer
Dim dataValue() As Variant
ReDim gpCode(0)
ReDim dataValue(0)
Mode = acSelectionSetAll
gpCode(0) = 0
dataValue(0) = "dimension"
Dim groupCode As Variant, dataCode As Variant
groupCode = gpCode
dataCode = dataValue
ObjSelectionSet.Select Mode, , , groupCode, dataCode
Dim tntry As AcadEntity
For Each tntry In ObjSelectionSet
Entry.Layer = "尺寸标注"
Entry.Update
Next Entry
ObjSelectionSet.Clear
gpCode(0) = 0
dataValue(0) = "text"
groupCode = gpCode
dataCode = dataValue
ObjSelectionSet.Select Mode, , , groupCode, dataCode
For Each Entry In ObjSelectionSet
Entry.Layer = "文字"
Entry.Update
Next Entry
ObjSelectionSet.Clear
ObjSelectionSet.Delete
ThisDrawing.SetVariable "cmdecho", scmde
代码完。