I can't create point at the MidPoint position.
How can I draw Point at the correct position ?
I got EdgePoint datum and got xyz by using EdgePoint.GetPointCoordinates method.
I run CreatePoint method, but its position is wrong.
' Select MidPoint
swModel.SelectMidpoint
' Get selected EDGE
Dim edgep As SldWorks.EdgePoint
Set edgep = swSelMgr.GetSelectedObject6(2, -1) ' first:Edge, second:EdgePoint(PointRef)
Dim swEdgePt As EdgePoint
Set swEdgePt = edgep
' Get MidPoint Coordinates
Dim mx As Double
Dim my As Double
Dim mz As Double
Call swEdgePt.GetPointCoordinates(mx, my, mz)
Dim mPt(0 To 2) As Double
mPt(0) = mx
mPt(1) = my
mPt(2) = mz
' Create Point at the midpoint position
' But its position is wrong.
Dim skPt As SketchPoint
Set skPt = swModel.SketchManager.CreatePoint(mPt(0), mPt(1), mPt(2))
Thanks.
Hi Sayuri,
Please try this below code to create point in selected edge midpoint.
Dim swApp As SldWorks.SldWorks
Dim swmodel As SldWorks.ModelDoc2
Dim swSelMgr As SldWorks.SelectionMgr
Dim boolstatus As Boolean
Dim swedgept As SldWorks.EdgePoint
Dim swview As SldWorks.View
Dim swdraw As SldWorks.DrawingDoc
Dim swfeat As SldWorks.Feature
Dim swViewXform As SldWorks.MathTransform
Dim skPt As SketchPoint
Dim swMathUtil As SldWorks.MathUtility
Dim swModelMidPt As SldWorks.MathPoint
Dim swViewMidPt As SldWorks.MathPoint
Dim x As Double
Dim y As Double
Dim z As Double
Dim nPtData(2) As Double
Dim vPtData As Variant
Sub main()
Set swApp = Application.SldWorks
Set swmodel = swApp.ActiveDoc
Set swdraw = swmodel
Set swSelMgr = swmodel.SelectionManager
Set swMathUtil = swApp.GetMathUtility
Set swfeat = swmodel.FeatureByName("Drawing view1")
Set swview = swfeat.GetSpecificFeature2
boolstatus = swmodel.Extension.SelectByRay(0.392427213904828, 0.466024887472847, 4.99999999999545E-03, 0, 0, -1, 2.78453424783087E-03, 1, False, 0, 0)
swmodel.SelectMidpoint
Set swedgept = swSelMgr.GetSelectedObject6(2, -1)
swedgept.GetPointCoordinates x, y, z
nPtData(0) = x
nPtData(1) = y
nPtData(2) = z
vPtData = nPtData
Set swModelMidPt = swMathUtil.CreatePoint(vPtData)
Set swViewXform = swview.ModelToViewTransform
Set swViewMidPt = swModelMidPt.MultiplyTransform(swViewXform)
x = swViewMidPt.ArrayData(0)
y = swViewMidPt.ArrayData(1)
z = swViewMidPt.ArrayData(2)
swmodel.SketchManager.CreatePoint x, y, z
End Sub
Manikandan