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

xieke-111 发表于 2006-4-20 20:28:00

在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 发表于 2006-4-21 09:10:00

本帖最后由作者于 2006-4-21 9:51:17 编辑 好像都没有人回答啊！ 

我在继续查了一些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 Part 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 Part = swApp.ActiveDoc

 

p1x = TextBox1.Text

 

p1y = TextBox2.Text

 

p1z = TextBox3.Text

 

p2x = TextBox4.Text

 

p2y = TextBox5.Text

 

p2z = TextBox6.Text

 

h = TextBox7.Text

 

boolstatus = Part.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 Part = swApp.ActiveDoc

 

 

Set theSketch = Part.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

 

图片如下： 

http://sunlion.3322.org/blogpic/20064210494935975.jpg

页: [1]

明经CAD社区's Archiver

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