社区 › Auto Lisp › VBA-使用组码

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

VBA-使用组码

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

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

 
问题是

         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

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

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

 
不是这样的：
 

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

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

你好
 
我认为这应该管用
 

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

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

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

 
没问题
干杯
 
~'J'~

查看完整版本: VBA-使用组码