streng 发表于 2022-7-6 12:01:17

选择集属性

你好
 
希望有人能帮忙。
 
我创建了一个选择集,将属性块分组,并将数据存储在一个数组中。
 
我为实现两件事感到震惊,即:
 
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

streng 发表于 2022-7-6 13:41:06

已经整理好了
 
轻松的时候你知道怎么做,应该先想到这一点!!
 
RefEdit(x, 4) = (Array1(0).Layer)
                                 RefEdit(x, 5) = (Array1(0).color)
页: [1]
查看完整版本: 选择集属性