VBA-使用组码

BUrBaKy · 发表于 2022-7-6 23:00:24

你好。
我写了这个小代码：


  Dim entObj As AcadEntity
  Dim ssetObj As AcadSelectionSet
  Dim grpCode(1) As Integer
  Dim dataVal(1) As Variant
  
  Dim x, y, z As Double
  
  grpCode(0) = 0
  dataVal(0) = "MTEXT,TEXT"  'the type of the objects
  grpCode(1) = 8
  dataVal(1) = "COTE,SECTIUNI" 'the names of the layers 
  
   On Error Resume Next
   Set ssetObj = ThisDrawing.SelectionSets.Add(SetName)
   If Err.Number <> 0 Then
       Set ssetObj = ThisDrawing.SelectionSets.Item(SetName)
   End If
  
  ssetObj.Clear
  Set ssetObj = ThisDrawing.SelectionSets.Add("SS01")
  ssetObj.SelectOnScreen grpCode, dataVal
  
  For i = 0 To ssetObj.Count - 1
           x = ssetObj.Item(i).InsertionPoint(0)
           y = ssetObj.Item(i).InsertionPoint(1)
           z = ssetObj.Item(i).InsertionPoint(2)
   Next i

问题是

copy

 
           x = ssetObj.Item(i).InsertionPoint(0)
           y = ssetObj.Item(i).InsertionPoint(1)
           z = ssetObj.Item(i).InsertionPoint(2)

不起作用。
如果我创建一个手表，我可以看到每个ssetObj。项一个称为InsertionPoint的值，表示x、y和z轴的插入点值。

有没有办法获取每个ssetObj的插入点值。项目

我也想过使用组码。我发现插入点的组码是“40”，但我不知道使用什么命令来获取值。

提前感谢！

Lee Mac · 发表于 2022-7-6 23:20:31

我是一个口齿不清的家伙，但，这应该吗

copy


   On Error Resume Next
   Set ssetObj = ThisDrawing.SelectionSets.Add(SetName)
   If Err.Number <> 0 Then
       Set ssetObj = ThisDrawing.SelectionSets.Item(SetName)
   End If

不是这样的：

copy


   On Error Resume Next
   Set ssetObj = ThisDrawing.SelectionSets.Add([color=Red][b]"SS01"[/b][/color])
   If Err.Number <> 0 Then
       Set ssetObj = ThisDrawing.SelectionSets.Item([b][color=Red]"SS01"[/color][/b])
   End If

Joro-- · 发表于 2022-7-6 23:29:33

你好

我认为这应该管用

copy


Sub Test()
   On Error Resume Next
   
   Dim ssetObj As AcadSelectionSet
   Dim SetName As String
   SetName = "SS01"
   ThisDrawing.SelectionSets(SetName).Delete
   If Err Then Err.Clear
   Set ssetObj = ThisDrawing.SelectionSets.Add(SetName)
  Dim grpCode(1) As Integer
  Dim dataVal(1) As Variant
  
  grpCode(0) = 0
  dataVal(0) = "MTEXT,TEXT"  'the type of the objects
  grpCode(1) = 8
  dataVal(1) = "COTE,SECTIUNI" 'the names of the layers
  
  
  ssetObj.SelectOnScreen grpCode, dataVal
  
  For i = 0 To ssetObj.Count - 1
           Dim var As Variant
           var = ssetObj.Item(i).InsertionPoint
           Debug.Print " x = " & var(0)
           Debug.Print " y = " & var(1)
           Debug.Print " z = " & var(2)
           Debug.Print
   Next i
End Sub

当做
乔罗

fixo · 发表于 2022-7-6 23:43:23

通过选择循环，您需要按文本和多行文字的类型分别投射对象
请尝试：
选项ExplicitSub TestSelection（）Dim entObj As AcadEntity Dim oText As AcadText Dim oMText As AcadMText Dim ssetObj As AcadSelectionSet Dim grpCode（1）As Integer Dim dataVal（1）As Variant Dim SetName As String Dim x As Double，y As Double，z As Double'

BUrBaKy · 发表于 2022-7-6 23:54:25

感谢您的快速回复。
我试图应用你的代码，但它们对我无效。然而，我挖掘了更多，发现了一些有用的东西，这是你的回复的一种组合。
[code]尺寸x为双精度，y为双精度，z为双精度'

fixo · 发表于 2022-7-7 00:07:48

没问题
干杯

~'J'~

[编程交流] VBA-使用组码

发表回复

精选推荐