选择集属性
你好希望有人能帮忙。
我创建了一个选择集,将属性块分组,并将数据存储在一个数组中。
我为实现两件事感到震惊,即:
1.textstring(0)所在的层
2、此文本字符串的颜色设置
这些值都出现在属性编辑器中,但我需要在我的用户表单中使用它们,以便进一步编辑。
希望有人能帮忙,希望我能充分解释我的问题。
到目前为止,我的代码是
Option Explicit
Dim intCode(1) As Integer
Dim varData(1) As Variant
Dim elem As AcadEntity
Dim Array1 As Variant
Dim aCount As Long
Dim RefNum As Long
Dim RefEdit() As String
Dim iNo As Integer
Dim TotalRef As Long
Dim x As Long
Dim PrefixArray() As String
Dim i As Long
Dim count As Long
Dim IsItThere As Boolean
Dim MyLayer As AcadLayer
Private Sub UserForm_Initialize()
'Gathers together all reference blocks
intCode(0) = 0: varData(0) = "Insert"
intCode(1) = 2: varData(1) = "REF1_50"
TotalRef = AllSS(intCode, varData)
ReDim RefEdit(0 To TotalRef, 0 To 6)
For Each elem In ThisDrawing.SelectionSets.Item("TempSSet")
'Using IsItThere to eliminate duplicates from end result - This creates a new 2d array called prefixarray
IsItThere = False
Array1 = elem.GetAttributes
RefEdit(x, 0) = (Array1(0).TextString)
RefEdit(x, 1) = (Array1(1).TextString)
RefEdit(x, 2) = (Array1(2).TextString)
RefEdit(x, 3) = elem.Layer
'RefEdit(x,4) = layer of textstring0 within elem block
'RefEdit(x,5) = colour of textstring0 within elem block
Next elem
End Sub
Sub SSClear()
Dim SSS As AcadSelectionSets
On Error Resume Next
Set SSS = ThisDrawing.SelectionSets
If SSS.count > 0 Then
SSS.Item("TempSSet").Delete
End If
End Sub
Function AllSS(Optional grpCode As Variant, Optional dataVal As Variant) As Integer
Dim TempObjSS As AcadSelectionSet
SSClear
Set TempObjSS = ThisDrawing.SelectionSets.Add("TempSSet")
'pick selection set
If IsMissing(grpCode) Then
TempObjSS.Select acSelectionSetAll
Else
TempObjSS.Select acSelectionSetAll, , , grpCode, dataVal
End If
AllSS = TempObjSS.count
End Function 已经整理好了
轻松的时候你知道怎么做,应该先想到这一点!!
RefEdit(x, 4) = (Array1(0).Layer)
RefEdit(x, 5) = (Array1(0).color)
页:
[1]