显示对象坐标
大家好，我不熟悉AutoCAD VBA。我想创建一个带有按钮和列表框的表单，单击按钮后，会显示一个msgbox，要求用户选择一个/多个功能/对象，然后单击空格键进行确认。然后特征的坐标将显示在列表框中。
我的问题是，我如何做第一部分-通过鼠标点击/屏幕选择来获取功能？
谢谢大家 [列表]
[*]打开VBA编辑器
[*]插入表单
[*]下拉列表视图“listView1”和2个按钮“cmdSelect”和“cmdExit”
[*]添加此代码：
[/列表]
Option Explicit
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
' require Microsoft ListView Control version 6.0
' in Constructor window->right click on field->
' click "Additional controls", scroll down
' and check box for "Microsoft ListView Control version 6.0"
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
Private Sub UserForm_Initialize()
Me.Width = 272
ListView1.Width = 264
ListView1.ListItems.Clear
ListView1.Arrange = 0 'lvwAutoLeft
ListView1.View = 3 'lvwReport
ListView1.GridLines = True
' add columns
ListView1.ColumnHeaders.Add 1, "BlockName", "Block Name", 80, 0
ListView1.ColumnHeaders.Add 2, "X", "X", 60, 0
ListView1.ColumnHeaders.Add 3, "Y", "Y", 60, 0
ListView1.ColumnHeaders.Add 4, "Z", "Z", 60, 0
ListView1.FullRowSelect = True
End Sub
Private Sub cmdSelect_Click()
Dim oEnt As AcadEntity
Dim oblk As AcadBlockReference
Dim itm As Object 'ListItem
Dim oBlocks As AcadBlocks
Dim oBlock As AcadBlock
Dim oBlkRef As AcadBlockReference
Dim ipt As Variant
Dim fType(0) As Integer
Dim fData(0) As Variant
Dim oSset As AcadSelectionSet
Dim iCount As Integer
Dim dxfCode, dxfData
Dim tmp(3)
Dim blkColl As New Collection
fType(0) = 0: fData(0) = "INSERT"
On Error GoTo Err_Trapp
For Each oSset In ThisDrawing.SelectionSets
If oSset.Name = "$Blocks$" Then
oSset.Delete
Exit For
End If
Next oSset
Set oSset = ThisDrawing.SelectionSets.Add("$Blocks$")
dxfCode = fType
dxfData = fData
Me.Hide
oSset.SelectOnScreen dxfCode, dxfData
iCount = 0
For Each oEnt In oSset
Set oBlkRef = oEnt
ipt = oBlkRef.InsertionPoint
tmp(0) = oBlkRef.EffectiveName
tmp(1) = ipt(0): tmp(2) = ipt(1): tmp(3) = ipt(2)
blkColl.Add tmp
Erase tmp
Next oEnt
oSset.Delete
Set oSset = Nothing
Dim i As Long, j As Long
'populate array
ReDim blkvar(blkColl.Count - 1, 1) As String
For i = 1 To blkColl.Count
blkvar(i - 1, 0) = blkColl.item(i)(0)
blkvar(i - 1, 1) = blkColl.item(i)(1)
Set itm = ListView1.ListItems.Add(1, , blkColl.item(i)(0))
itm.SubItems(1) = Round(blkColl.item(i)(1), 3)
itm.SubItems(2) = Round(blkColl.item(i)(2), 3)
itm.SubItems(3) = Round(blkColl.item(i)(3), 3)
Next
Me.Show
Err_Trapp:
End Sub
Private Sub ListView1_Click()
If ListView1.SelectedItem.Selected = True Then
Dim bname As String
bname = ListView1.SelectedItem.Text
Dim x As Double
x = CDbl(ListView1.SelectedItem.SubItems(1))
Dim y As Double
y = CDbl(ListView1.SelectedItem.SubItems(2))
Dim z As Double
z = CDbl(ListView1.SelectedItem.SubItems(3))
MsgBox "Block : " & vbCr & bname & vbCr & _
"Position: " & vbCr & "x = " & x & vbCr & "y = " & y & vbCr & "z = " & z
End If
End Sub
Private Sub cmdExit_Click()
Unload Me
End Sub
~'J'~
页:
[1]