vertex in sldprt
Hope, drawing a point in slddrw
follow code, drawing a point is error.
Private Sub del()
Dim SwSelMgr As SelectionMgr, SwMathUtil As MathUtility
Dim SwApp As SldWorks.SldWorks, SwModel As ModelDoc2
Set SwApp = Application.SldWorks
Set SwModel = SwApp.ActiveDoc
Set SwMathUtil = SwApp.GetMathUtility
Dim SwDraw As DrawingDoc
Set SwDraw = SwModel
Dim SwView As View
Set SwView = SwDraw.GetFirstView
Set SwView = SwView.GetNextView
''
Set SwModel = SwView.ReferencedDocument
Set SwSelMgr = SwModel.SelectionManager
Dim SwVertex As Vertex
Set SwVertex = SwSelMgr.GetSelectedObject5(1)
Dim SwMathPt As MathPoint, Pt(2)
With SwVertex
Debug.Print .GetPoint(0), .GetPoint(1), .GetPoint(2)
Pt(0) = .GetPoint(0)
Pt(1) = .GetPoint(1)
Pt(2) = .GetPoint(2)
End With
''
Set SwMathPt = SwMathUtil.CreatePoint(Pt)
With SwMathPt
Debug.Print .ArrayData(0), .ArrayData(1), .ArrayData(2)
End With
tmp = SwView.SelectEntity(SwVertex, True)
''
Dim vOutLine
vOutLine = SwView.GetOutline
Dim SwXForm As MathTransform
Set SwXForm = SwView.ModelToViewTransform
Dim SwViewPt As MathPoint
Set SwViewPt = SwMathPt.MultiplyTransform(SwXForm)
Dim SkPt As SketchPoint
Dim Xx As Double, Yy As Double, Zz As Double
With SwViewPt
Xx = .ArrayData(0)
Yy = .ArrayData(1)
Zz = .ArrayData(2)
End With
Dim oScale
oScale = 1 / SwView.ScaleDecimal
'
Xx = Xx * oScale
Yy = Yy * oScale
Zz = Zz * oScale
''
Xx = vOutLine(0) + Xx
Yy = vOutLine(1) + Yy
Set SkPt = SwDraw.CreatePoint2(Xx, Yy, Zz)
Stop
End Sub
***************************************
how to get coordinates of selected vertexes on ... | SOLIDWORKS Forums https://forum.solidworks.com/message/141098#141098#141098
Dim swMathUtils As SldWorks.MathUtility
Dim swXform As SldWorks.MathTransform
Dim swMathPt As SldWorks.MathPoint
Set swMathUtils = swApp.GetMathUtility
Set swXform = swView.ModelToViewTransform
Set swMathPt = swMathUtils.CreatePoint(swVertex.GetPoint())
Set swMathPt = swMathPt.MultiplyTransform(swXform)
'Now the coordinates converted to drawing space
Debug.Print swMathPt.ArrayData(0) & "; " & swMathPt.ArrayData(1)
Private Sub del20170609()
Dim SwApp As SldWorks.SldWorks, SwModel As ModelDoc2
Set SwApp = Application.SldWorks
Set SwModel = SwApp.ActiveDoc
Dim SwSelMgr As SelectionMgr
Set SwSelMgr = SwModel.SelectionManager
Dim SwDispDim As DisplayDimension, SwAnn As Annotation
Set SwDispDim = SwSelMgr.GetSelectedObject5(1)
Set SwAnn = SwDispDim.GetAnnotation
Dim Ss, Ss1
With SwAnn
Ss = .GetAttachedEntities
Ss1 = .GetAttachedEntityTypes
End With
Dim SkPt As SketchPoint, PtArr(2) As Double
Set SkPt = Ss(0)
With SkPt
Debug.Print .X, .Y, .Z
PtArr(0) = .X
PtArr(1) = .Y
End With
Stop
Dim SwDraw As DrawingDoc
Set SwDraw = SwModel
Dim SwView As View, vPos
Set SwView = SwDraw.GetFirstView
Set SwView = SwView.GetNextView
vPos = SwView.Position
Dim SwMathUtil As SldWorks.MathUtility
Set SwMathUtil = SwApp.GetMathUtility
Dim SwXForm As SldWorks.MathTransform
Set SwXForm = SwView.ModelToViewTransform
Dim SwMathPt As SldWorks.MathPoint
Set SwMathPt = SwMathUtil.CreatePoint(PtArr)
Set SwMathPt = SwMathPt.MultiplyTransform(SwXForm)
Dim Xx, Yy, oScale
oScale = 1 / SwView.ScaleDecimal
With SwMathPt
Xx = .ArrayData(0) * oScale + vPos(0)
Yy = .ArrayData(1) * oScale + vPos(1)
End With
Stop
Set SkPt = SwModel.CreatePoint2(Xx, Yy, 0)
End Sub
''
'
''
Private Sub del201706102()
Dim SwApp As SldWorks.SldWorks, SwModel As ModelDoc2
Set SwApp = Application.SldWorks
Set SwModel = SwApp.ActiveDoc
Dim SwMathUtil As MathUtility
Set SwMathUtil = SwApp.GetMathUtility
Dim SwDraw As DrawingDoc
Set SwDraw = SwModel
Dim SwView As View, Ss, PtArr
Dim SwDispDim As DisplayDimension, SwDim As Dimension
Set SwView = SwDraw.GetFirstView
Do While Not SwView Is Nothing
Set SwDispDim = SwView.GetFirstDisplayDimension
Do While Not SwDispDim Is Nothing
PtArr = retuDimMathPt(SwModel, SwMathUtil, SwView, SwDispDim)
Set SwDispDim = SwDispDim.GetNext
Loop
Set SwView = SwView.GetNextView
Loop
End Sub
Function retuDimMathPt(SwModel As ModelDoc2, SwMathUtil As MathUtility, SwView As View, SwDispDim As DisplayDimension)
Dim SkPt As SketchPoint
Dim SwXForm As MathTransform
Set SwXForm = SwView.ModelToViewTransform
Dim SwDim As Dimension, SwAnn As Annotation
With SwDispDim
Set SwDim = .GetDimension
Debug.Print SwDim.FullName
Set SwAnn = .GetAnnotation
SwAnn.Select False
End With
Dim mPt As MathPoint, Pt(2) As Double
With SwDim
Ss = SwAnn.GetPosition
For ii = 0 To 2
Debug.Print Round(Ss(ii), 4),
Next ii
Xx = Ss(0)
Yy = Ss(1)
Xx = Xx / SwView.ScaleDecimal
Yy = Yy / SwView.ScaleDecimal
Set SkPt = SwModel.CreatePoint2(Xx, Yy, 0)
Debug.Print
Stop
''
Ss = .ReferencePoints
For ii = 0 To 2
Set mPt = Ss(ii)
Set mPt = mPt.MultiplyTransform(SwXForm)
With mPt
Xx = .ArrayData(0)
Yy = .ArrayData(1)
Xx = Xx / SwView.ScaleDecimal
Yy = Yy / SwView.ScaleDecimal
Debug.Print ii, Xx, Yy
End With ''
Set SkPt = SwModel.CreatePoint2(Xx, Yy, 0)
Next ii
End With
End Function
SolidworksApi macros