哦,等等!我很抱歉地告诉你,不幸的是,它不会改变嵌套外部参照的图层颜色。对此有什么解决办法吗?谢谢 为什么需要这样做? 我不认为外部参照的图层颜色实际上做了什么。 这是一个东西的一些东西。此处的代码用于获取外部参照的路径,但显示了一种钻取嵌套外部参照的方法。如果你需要帮忙组装,请告诉我
Private Sub LoadXrefs()
Dim objSelSets As AcadSelectionSets
Dim objSelSet As AcadSelectionSet
Dim intType(0) As Integer
Dim varData(0) As Variant
Dim strPaths() As String
Dim intCnt As Integer
Dim objXref As AcadExternalReference
Dim objEnt As AcadEntity
Dim objBlk As AcadBlock
Dim objBlks As AcadBlocks
Dim intDuplicate As Integer
Dim objDuplicate As AcadEntity
Dim boolDuplicate As Boolean
Set objBlks = ThisDrawing.Blocks
Set objSelSets = ThisDrawing.SelectionSets
For Each objSelSet In objSelSets
If objSelSet.Name = "GetXrefPaths" Then
objSelSets.Item("GetXrefPaths").Delete
Exit For
End If
Next
Set objSelSet = objSelSets.Add("GetXrefPaths")
intType(0) = 0: varData(0) = "INSERT"
objSelSet.Select acSelectionSetAll, , , intType, varData
For Each objEnt In objSelSet
Set objBlk = objBlks(objEnt.Name)
If objBlk.IsXRef Then
boolDuplicate = False
For intDuplicate = 1 To colXrefs.Count
Set objDuplicate = colXrefs.Item(intDuplicate)
If objDuplicate.Name = objEnt.Name Then
boolDuplicate = True
Exit For
End If
Next intDuplicate
If boolDuplicate = False Then
colXrefs.Add objEnt '.Path
GetNested objBlk
End If
End If
Next objEnt
End Sub
Private Function GetNested(objBlk As AcadBlock) As Integer
Dim objXref As AcadExternalReference
Dim objBlkRef As AcadBlockReference
Dim objEnt As AcadEntity
Dim objNext As AcadBlock
For Each objEnt In objBlk
If TypeOf objEnt Is AcadBlockReference Then
Set objBlkRef = objEnt
Set objNext = ThisDrawing.Blocks(objBlkRef.Name)
If objNext.IsXRef Then
Set objXref = objEnt
colXrefs.Add objXref
GetNested objNext
End If
End If
Next
GetNested = colXrefs.Count
End Function
已经有一段时间没有真正研究过该代码了。我不知道为什么GetNested是一个函数而不是子函数。
Danellis,只要颜色/lt设置为bylayer,更改外部参照图层就会更改这些图层上对象的外观。与任何其他层上的任何其他对象相同。 什么是colXrefs? 在这种情况下colxrefs是公开声明的集合
页:
1
[2]