priyanka_mehta 发表于 2022-7-6 11:04:02

仅选择块参照an

大家好,
 
我创建了一个选择集,我只希望包含文本和块引用,以从中检索信息。我一直在使用以下代码
 



For Each SOS In ThisDrawing.SelectionSets
    If SOS.name = "MySS" Then
       ThisDrawing.SelectionSets("MySS").Delete
    Exit For
    End If
Next

intCode(0) = 0: varData(0) = "BLOCK REFERENCE,TEXT"
ThisDrawing.SelectionSets.add ("MySS")
Set objSS = ThisDrawing.SelectionSets("MySS")
objSS.SelectOnScreen intCode, varData

If objSS.Count < 1 Then
    MsgBox "Nothing Selected!"
Exit Sub
End If



For Each objent In objSS
Select Case objent.ObjectName
   Case "AcDbBlockReference"
   Set block = objent
       x = block.insertionPoint(0)
       y = block.insertionPoint(1)
MsgBox "x: " & x & vbCrLf & "y: " & y

   Case "AcDbText"
   Set textobj = objent
   MsgBox textobj.textstring
   
End Select
Next


 
 
 
 
这将允许我选择文本,但不允许块引用。
我想知道块参照的确切名称,我可以在以下内容中使用:
 
intCode(0)=0:varData(0)=“块参考,文本”
 
仅选择块参照和文字的步骤
 
 
谢谢和问候,
普里扬卡

SEANT 发表于 2022-7-6 11:26:37

intCode(0)=0:varData(0)=“插入,文本”
 
你有没有研究过acSelectionSetCrossingPolygon中与该线程中的圆相交的实体?
 
http://www.cadtutor.net/forum/showthread.php?t=34980

priyanka_mehta 发表于 2022-7-6 11:38:48

嗨,肖特,
 
这个“insert”关键字按我希望的方式工作。谢谢
 
我尝试了circle代码,但对于我的编程技能来说,它实际上有点太复杂了。不幸的是,我对此无能为力。无论如何,非常感谢!
 
当做
普里扬卡

PeterPan9720 发表于 2022-7-6 11:47:30

谢谢你的代码,
请你帮我在图纸中选择更多具有特定块名(X1-O-180)的块,并获取每个块的坐标,好吗?
 
我尝试了以下代码,但没有成功,我认为问题在选择范围内!。
 
IntCOde(0)=“0”:VarData(0)=“X1-O-180”
objSS。选择acSelectionSetAll、IntCOde、VarData
 
厚度

SEANT 发表于 2022-7-6 12:01:40

请参阅上述代码的修改。
 
Sub getzInsPt()

Dim intCode(1) As Integer
Dim varData(1) As Variant
Dim X As Double
Dim Y As Double
Dim Z As Double
Dim Block As AcadBlockReference
Dim SOS As AcadSelectionSet
Dim objent As AcadEntity
Dim strMsg As String


For Each SOS In ThisDrawing.SelectionSets
    If SOS.Name = "MySS" Then
       ThisDrawing.SelectionSets("MySS").Delete
    Exit For
    End If
Next

intCode(0) = 0: varData(0) = "INSERT"
intCode(1) = 2: varData(1) = "X1-O-180"
ThisDrawing.SelectionSets.Add ("MySS")
Set SOS = ThisDrawing.SelectionSets("MySS")
SOS.Select acSelectionSetAll, , , intCode, varData

If SOS.Count < 1 Then
    MsgBox "Nothing Selected!"
Exit Sub
End If



For Each objent In SOS

   Set Block = objent
       X = Block.InsertionPoint(0)
       Y = Block.InsertionPoint(1)
       Z = Block.InsertionPoint(2)
       strMsg = strMsg & "x: " & X & ", y: " & Y & ", z: " & Z & vbCrLf
Next
MsgBox strMsg

End Sub

PeterPan9720 发表于 2022-7-6 12:06:43

 
非常感谢你!现在它开始工作了。
 
我稍后会问你一些其他细节!。。。。。。
 
最终范围是在文本编辑器或excel操作后,将从“X1-O-180”块中提取的一些属性或从其自身中提取的属性转移到放置在图形上的新块中。
 
这是一项艰苦的工作?
 
所以我会再次努力。
 
谢谢你的耐心。
页: [1]
查看完整版本: 仅选择块参照an