如何用VB读取autocad的块所在位置的坐标
就是用vb二次开发autocad时,如何读取块的插入点的坐标,求诸位能给出相关的语句,谢谢了。...
就是用vb二次开发autocad时,如何读取块的插入点的坐标,求诸位能给出相关的语句,谢谢了。
展开
1个回答
展开全部
VBA写的,试试,换成VB增加
Dim AcadApp As AcadApplication
Set AcadApp = GetObject(, "AutoCad.Application")
把Thisdrawing改成AcadApp.ActiveDocument就行了
将前十个图块的的名字,坐标给出来,不定数量手要点软,呵呵
Sub BlockPointqa()
On Error GoTo Err:
Dim Po(0 To 2) As Double
Dim Var As Variant
Dim FType(0) As Integer
Dim FData(0) As Variant
Dim sset As AcadSelectionSet
Dim Entry As AcadEntity
Dim OnTOx As Double
FType(0) = 2: FData(0) = "*" ‘过虑图块
Set sset = ThisDrawing.SelectionSets.Add("SSZSAewe20")
sset.SelectOnScreen FType, FData
OnTOx = 0
For Each Entry In sset
If Entry.ObjectName = "AcDbBlockReference" And OnTOx < 10 Then
’再过虑一次,同时定上数目
OnTOx = OnTOx + 1
Var = Entry.InsertionPoint
Po(0) = Var(0): Po(1) = Var(1): Po(2) = Var(2)
MsgBox "图块名:" + Entry.Name & vbCr & _
"X坐标:" + CStr(Int(Po(0) * 1000) / 1000) & vbCr & _ ‘设为三位小数点
"Y坐标:" + CStr(Int(Po(1) * 1000) / 1000) & vbCr & _
"Z坐标:" + CStr(Int(Po(2) * 1000) / 1000)
End If
Next
Err:
sset.Delete
End Sub
Dim AcadApp As AcadApplication
Set AcadApp = GetObject(, "AutoCad.Application")
把Thisdrawing改成AcadApp.ActiveDocument就行了
将前十个图块的的名字,坐标给出来,不定数量手要点软,呵呵
Sub BlockPointqa()
On Error GoTo Err:
Dim Po(0 To 2) As Double
Dim Var As Variant
Dim FType(0) As Integer
Dim FData(0) As Variant
Dim sset As AcadSelectionSet
Dim Entry As AcadEntity
Dim OnTOx As Double
FType(0) = 2: FData(0) = "*" ‘过虑图块
Set sset = ThisDrawing.SelectionSets.Add("SSZSAewe20")
sset.SelectOnScreen FType, FData
OnTOx = 0
For Each Entry In sset
If Entry.ObjectName = "AcDbBlockReference" And OnTOx < 10 Then
’再过虑一次,同时定上数目
OnTOx = OnTOx + 1
Var = Entry.InsertionPoint
Po(0) = Var(0): Po(1) = Var(1): Po(2) = Var(2)
MsgBox "图块名:" + Entry.Name & vbCr & _
"X坐标:" + CStr(Int(Po(0) * 1000) / 1000) & vbCr & _ ‘设为三位小数点
"Y坐标:" + CStr(Int(Po(1) * 1000) / 1000) & vbCr & _
"Z坐标:" + CStr(Int(Po(2) * 1000) / 1000)
End If
Next
Err:
sset.Delete
End Sub
本回答被提问者采纳
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询