[VBA]怎么修改颜色??

bai_cai101 发表于 2005-1-31 11:22:00

如果实体的颜色是随层显示,怎么样运用选择集有选择地修改其颜色?

bai_cai101 发表于 2005-1-31 11:27:00

[VBA]

本帖最后由作者于 2005-1-31 13:32:14 编辑

比如一个DWG文件,里面的实体的颜色,图层都很乱,需要按实体颜色的不同进行归入不同的图层,但有些实体的颜色为随层显示,我编的程序对随层显示的实体不起作用,请大家指点;我的程序

bai_cai101 发表于 2005-1-31 13:26:00

Sub qingli() Dim tuceng As AcadLayer On Error Resume Next If IsNull(ThisDrawing.Layers.Item("0")) Then Set tuceng = ThisDrawing.Layers.Add("0") tuceng.color = 7 tuceng.Lineweight = acLnWt035 End If

If IsNull(ThisDrawing.Layers.Item("细线")) Then Set tuceng = ThisDrawing.Layers.Add("细线") tuceng.color = 1 tuceng.Lineweight = acLnWt013 End If Dim SSset As AcadSelectionSet '建立选择集"SS1" Dim enti As AcadEntity If Not IsNull(ThisDrawing.SelectionSets.Item("SS1")) Then Set SSset = ThisDrawing.SelectionSets.Item("SS1") SSset.Delete End If Set SSset = ThisDrawing.SelectionSets.Add("SS1") Dim filterType As Integer Dim filterData As Variant filterType = 8 For Each tuceng In ThisDrawing.Layers filterType = tuceng.Name SSset.Select acSelectionSetAll For Each enti In SSset

If enti.Layer = "0" Then '图层"0" If tuceng.color = 7 Then If enti.color = acByLayer Or enti.color = 7 Or enti.color = acByBlock Then ' MsgBox tuceng.Name & "," & enti.color enti.color = 7 enti.Update Else 'MsgBox tuceng.Name & "," & enti.color enti.color = 1 enti.Layer = "细线" enti.Update End If ElseIf tuceng.color = 1 Then If enti.color = 7 Or enti.color = acByBlock Then enti.color = 7 enti.Update Else enti.color = 1 enti.Layer = "细线" enti.Update End If Else If enti.color = 7 Or enti.color = acByBlock Then enti.color = 7 enti.Update Else enti.color = 1 enti.Layer = "细线" enti.Update End If End If 'End If ElseIf enti.Layer = "细线" Then '图层"细线" If tuceng.color = 7 Then If enti.color = acByLayer Or enti.color = 7 Or enti.color = acByBlock Then MsgBox tuceng.Name & tuceng.color & enti.color enti.color = 7 enti.Layer = "0" enti.Update Else 'MsgBox tuceng.Name & "," & enti.color enti.color = 1 'enti.Layer = "细线" enti.Update End If ElseIf tuceng.color = 1 Then If enti.color = 7 Or enti.color = acByBlock Then enti.color = 7 enti.Layer = "0" enti.Update Else enti.color = 1 'enti.Layer = "细线" enti.Update End If Else If enti.color = 7 Or enti.color = acByBlock Then enti.color = 7 enti.Layer = "0" enti.Update Else enti.color = 1 'enti.Layer = "细线" enti.Update End If End If 'End If Else ' enti.Layer <> "细线" And enti.Layer <> "0" Then '图层"其它" If tuceng.color = 7 Then If enti.color = acByLayer Or enti.color = 7 Or enti.color = acByBlock Then MsgBox tuceng.Name '& "," & enti.color enti.color = 7 enti.Layer = "0" enti.Update Else 'MsgBox tuceng.Name & "," & enti.color enti.color = 1 enti.Layer = "细线" enti.Update End If ElseIf tuceng.color = 1 Then If enti.color = 7 Or enti.color = acByBlock Then enti.color = 7 enti.Layer = "0" enti.Update Else enti.color = 1 enti.Layer = "细线" enti.Update End If Else If enti.color = 7 Or enti.color = acByBlock Then enti.color = 7 enti.Layer = "0" enti.Update Else enti.color = 1 enti.Layer = "细线" enti.Update End If End If End If

Next enti Next tuceng For Each tuceng In ThisDrawing.Layers If tuceng.Name = "0" Then tuceng.color = 7 tuceng.Lineweight = acLnWt035 End If If tuceng.Name = "细线" Then tuceng.color = 1 tuceng.Lineweight = acLnWt013 End If If tuceng.Name <> "0" And tuceng.Name <> "细线" And tuceng.Name <> "定义点" And tuceng.Name <> "Defpoints" Then tuceng.Delete End If Next tuceng SSset.clease SSset.Delete

End Sub

雪山飞狐_lzh 发表于 2005-1-31 13:59:00

选择图层为0，且随层，或者颜色为红色的实体：

Sub tta() On Error Resume Next Dim ss As AcadSelectionSet ThisDrawing.SelectionSets("Test").Delete Set ss = ThisDrawing.SelectionSets.Add("Test") Dim ft(6) As Integer, fd(6) ft(0) = -4: fd(0) = "<or" ft(1) = -4: fd(1) = "<and" ft(2) = 8: fd(2) = "0" ft(3) = 62: fd(3) = 256 ft(4) = -4: fd(4) = "and>" ft(5) = 62: fd(5) = 1 ft(6) = -4: fd(6) = "or>" ss.Select acSelectionSetAll, , , ft, fd MsgBox ss.Count

bai_cai101 发表于 2005-1-31 14:25:00

我对DXF不是很懂,也找不到这方面的资料!能否给我传一点过来,我的QQ79570611

邮箱:bai_cai101@163.com,多谢你了!!!!

<or,<and等我都不知道怎么用它???

雪山飞狐_lzh 发表于 2005-1-31 20:31:00

DXF 参考手册帮助里就有

bai_cai101 发表于 2005-2-5 11:08:00

谢谢你,

bai_cai101 发表于 2005-2-17 11:59:00

我看了一下DXF帮助,但没有看到像<or,<and 之类的说明!!版主能否再给几个例子让我模仿一下!多谢你了!!比如我想将实体按颜色归入不同的图层!白色的实体(包括随层,随块颜色)放入图层"0",红色放入"细线"图层,

页: [1]

明经CAD社区's Archiver

[VBA]怎么修改颜色??

[VBA]