[VBA]Solidworks草图环境下getpoint问题

xieke-111

在Solidworks 的草图绘制环境下如何获得鼠标点击后的点坐标
问题描述：
            建立好零件图后，用VBA写一个在 Solidworks草图环境下，点鼠标 左键后获得此点坐标的具体数字！

          发现很难办到，我写了部分代码如下：
sub main（）
Dim swApp, Part, SelMgr As Object
Dim retalAs Variant
Dim xyzvalue As String
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
Set SelMgr = Part.SelectionManager
boolstatus = Part.Extension.SelectByID("前视基准面", "PLANE", 0, 0, 0, False, 0, Nothing)
Part.ShowNamedView2 "*上下二等角轴测", 8
part.InsertSketch2 True
If (Part.GetActiveSketch Is Nothing) Then
swApp.SendMsgToUser "请建立一个活动文档"
Exit Sub
End If

If (SelMgr.GetSelectedObjectCount2 <> 0) Then

retal = SelMgr.GetSelectionPointInSketchSpace2(0, 0)

xyzvalue = "x=" & retal(0) * 1000 & "mm" & Chr(10) & "y=" & retal(1) * 1000 & "mm" & Chr(10) & "z=" & retal(2) * 1000 & "mm"

swApp.SendMsgToUser xyzvalue

End If
end sub

大致思路是这样的，但是却做不到；
本来是设计运行程序后，等到点鼠标左键然后就 把此点的坐标展示出来，但是感觉好象没有办法做到只有当点击左键时候，才显示 此点的坐标；
上面我写的那个东西，还没有等我点就直接显示为 0，0，0了！
所以我想问大家如果能做到呢？我看大前面一贴也是关于getpiont的，但是发现太不一样了！

下面是描述：
SelectionMgr::GetSelectionPointInSketchSpace2

Description

This method gets the selection point projected on to the active sketch and returned in sketch space. The selection point is projected on to the currently active sketch, resulting in a Z value, which is always 0.00.

Syntax (OLE Automation)

Retval = SelectionMgr.GetSelectionPointInSketchSpace2 ( Index, Mark)

Input:
 (long) Index
 Index position within the current list of selected items where AtIndex ranges from 1 to SelectionMgr::GetSelectedObjectCount2 (see Remarks)
 
Input:
 (long) Mark
 -1 = All selections regardless of marks

0 = only the selections without marks

Any other value = Value that was used to mark and select an object
 
Output:
 (VARIANT) Retval
 VARIANT of type SafeArray of 3 doubles (x,y,z)

其实还有几个API，但是发现，那些都是获得空间模型的点的，找了很久才发现这个API才是获得草图的点的；

希望各位老师指导；

xieke-111

好像都没有人回答啊！
我在继续查了一些API，比如GetSketchPoints，这些API要捕获的点，必须都是已经存在的点；
所以我总结了一下，在SLDWORKS只能是捕获到草图上已经存在了的点，而不能利用通过鼠标在草图上任意点一个点就能捕获到此点的坐标的；（如果哪位老师能找到什么好方法的话，请告诉我和大家吧！）
利用getsketchpoints写了一个练习程序：
这个程序主要是生成一个立方体块！
过程：画矩形对角的两点-》生成一个矩形面-》在此基础上进行拉伸

两种方式：
1.把矩形对角两点坐标和拉伸的厚度都输入，然后点确定OK（前提是进入SOLIDWORKS的零件图环境）
2.先进入SOLIDWORKS零件图环境，进入草图绘制状态，然后在草图上画图矩形对角两点，然后在运行这个程序，输入厚度，点   点用鼠标输入；

代码如下：
窗体代码：
Dim p1x, p1y, p1z, p2x, p2y, p2z, h As Double
Dim swApp As Object
Dim art As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Sub Operate(p1x, p1y, p1z, p2x, p2y, p2z, h)

Part.SketchRectangle p1x, p1y, p1z, p2x, p2y, p2z, 1
Part.FeatureManager.FeatureExtrusion True, False, False, 0, 0, h, 0,_
False, False, False, False, 0, 0, False, False, False, False, 1, 1, 1
Part.SelectionManager.EnableContourSelection = 0
End Sub

Private Sub CommandButton1_Click()
Set swApp = Application.SldWorks
Set art = swApp.ActiveDoc
p1x = TextBox1.Text
p1y = TextBox2.Text
p1z = TextBox3.Text
p2x = TextBox4.Text
p2y = TextBox5.Text
p2z = TextBox6.Text
h = TextBox7.Text
boolstatus = art.Extension.SelectByID("前视基准面", "PLANE",  0, 0, 0, False, 0, Nothing)
Part.ShowNamedView2 "*上下二等角轴测", 8
Part.InsertSketch2 True
Operate p1x / 1000, p1y / 1000, p1z / 1000, p2x / 1000, p2y / 1000, p2z / 1000, h / 1000
End Sub

Private Sub CommandButton2_Click()
Unload Me
End Sub

Private Sub CommandButton3_Click()
Me.Hide
Dim xyzvalue As String
Dim sketchPointArray As Variant

Dim theSketch As Object


Set swApp = Application.SldWorks

Set art = swApp.ActiveDoc

Set theSketch = art.GetActiveSketch2
If theSketch Is Nothing Then
MsgBox "请先进入草图绘制状态！"
Exit Sub
End If
sketchPointArray = theSketch.GetSketchPoints


 xyzvalue = "x1=" & sketchPointArray(0).X * 1000 & "mm" & Chr(10) &_
"y1=" & sketchPointArray(0).Y * 1000 & "mm" & Chr(10) &_ "z1=" & sketchPointArray(0).Z * 1000 & "mm" & Chr(10) & _
 "x2=" & sketchPointArray(1).X * 1000 & "mm" & Chr(10) & "y2=" &_ sketchPointArray(1).Y * 1000 & "mm" & Chr(10) & "z2=" & sketchPointArray(1).Z * 1000 &_ "mm"

swApp.SendMsgToUser xyzvalue
Part.ShowNamedView2 "*上下二等角轴测", 8
Operate sketchPointArray(0).X, sketchPointArray(0).Y, sketchPointArray(0).Z,_
sketchPointArray(1).X, sketchPointArray(1).Y, sketchPointArray(1).Z,_
TextBox7.Text / 1000


End Sub
模块1代码：

Sub main()
Load UserForm
UserForm.Show
End Sub
图片如下：