Private Sub ll()
Dim SwApp As SldWorks.SldWorks, SwModel As ModelDoc2
Set SwApp = Application.SldWorks
Set SwModel = SwApp.ActiveDoc
Dim SwDraw As DrawingDoc
Set SwDraw = SwModel
Dim SwView As View
Set SwView = SwDraw.GetFirstView
'SwDraw.ActivateView SwView.Name
'SwApp.ActiveDoc.ActiveView.FrameState = 1
xx = 0.09 '283462373492
yy = 0.03500318526879
zz = 0
SwModel.CreatePoint xx, yy, zz
tmp = SwModel.Extension.SelectByID2("", "EDGE", xx, yy, zz, False, 0, Nothing, 0)
Stop
End Sub
Private Sub ll1()
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 SwView As View, vPos(2) As Double
Set SwView = SwSelMgr.GetSelectedObject5(1)
vPos(0) = 0.1
vPos(1) = 0.1
SwView.Position = vPos
'SwModel.ForceRebuild3 False
''
Dim SwDispDim As DisplayDimension, SwDim As Dimension
Set SwDispDim = SwSelMgr.GetSelectedObject5(2)
Set SwDim = SwDispDim.GetDimension
Dim Pt, MathPt As MathPoint
Pt = SwDim.ReferencePoints
For ii = 0 To 2
Set MathPt = Pt(ii)
With MathPt
'Debug.Print ii, .ArrayData(0) * 1000, .ArrayData(1) * 1000, .ArrayData(2)
End With
Next ii
Dim SwAnn As Annotation, SkPt As SketchPoint, SkPt1 As SketchPoint
Set SwAnn = SwDispDim.GetAnnotation
Ss = SwAnn.GetAttachedEntities
For ii = 0 To 1
Set SkPt = Ss(ii)
With SkPt
Debug.Print ii, .X, .Y, .Z
Set SkPt1 = SwModel.CreatePoint2(.X, .Y / 2, .Z)
Debug.Print SkPt1.X, SkPt1.Y
End With
Next
End Sub
''
''
Private Sub ll7()
Dim Xls As Excel.Application, Rng As Range
Set Xls = GetObject(, "Excel.Application")
Set Rng = Xls.Selection
Dim SwApp As SldWorks.SldWorks, SwModel As ModelDoc2
Set SwApp = Application.SldWorks
Set SwModel = SwApp.ActiveDoc
Dim SwDraw As DrawingDoc
Set SwDraw = SwModel
Dim SwSelMgr As SelectionMgr
Set SwSelMgr = SwModel.SelectionManager
''
Dim X, Y, Xx, Yy
Dim AttEnt, AttEntTypes
Dim SwMathUtil As MathUtility
Set SwMathUtil = SwApp.GetMathUtility
Dim SwView As View
Set SwView = SwDraw.GetFirstView
Set SwView = SwView.GetNextView
''''
Dim VerDispDim As DisplayDimension, HorDispDim As DisplayDimension
Dim SwDim As Dimension, SwAnn As Annotation
''
tmp = SwModel.Extension.SelectByID2(Rng(1, 1) & "@" & SwView.Name, "DIMENSION", 0, 0, 0, False, 0, Nothing, 0)
Set VerDispDim = SwSelMgr.GetSelectedObject5(1)
''
tmp = SwModel.Extension.SelectByID2(Rng(2, 1) & "@" & SwView.Name, "DIMENSION", 0, 0, 0, False, 0, Nothing, 0)
Set HorDispDim = SwSelMgr.GetSelectedObject5(1)
''''
Dim oScale
oScale = 1 / SwView.ScaleDecimal
Dim SwViewXForm As MathTransform
Set SwViewXForm = SwView.ModelToViewTransform
'Set SwViewXForm = SwViewXForm.Inverse
Dim vPos
vPos = SwView.Position
Dim SwPt As SketchPoint, Ss As MathPoint
Xx = vPos(0) / SwView.ScaleDecimal
Yy = vPos(1) / SwView.ScaleDecimal
'Set SwPt = SwModel.CreatePoint2(Xx, Yy, 0)
Dim MathPt As MathPoint, Pt(2) As Double, SkPt As SketchPoint
Set SwAnn = HorDispDim.GetAnnotation
'Debug.Print SwAnn.GetName
AttEnt = SwAnn.GetAttachedEntities2
AttEntTypes = SwAnn.GetAttachedEntityTypes
'''
Set SkPt = AttEnt(1)
With SkPt
Pt(0) = .X
Pt(1) = .Y
End With
Set MathPt = SwMathUtil.CreatePoint(Pt)
Set MathPt = MathPt.MultiplyTransform(SwViewXForm)
With MathPt
'SwModel.CreatePoint .ArrayData(0) * oScale, .ArrayData(1) * oScale, 0
X = .ArrayData(0) + 6 / 1000
'X = Pt(0)
Y = .ArrayData(1) - 10 / 1000
''
Xx = .ArrayData(0) * oScale
Yy = .ArrayData(1) * oScale
End With
'Set SkPt = SwModel.CreatePoint2(Xx, Yy, 0)
''
SwAnn.SetPosition X, Y, 0
SwModel.ForceRebuild3 True
'Stop
End Sub
***************************************************
Private Sub ll()
Dim SwApp As SldWorks.SldWorks, SwModel As ModelDoc2
Set SwApp = Application.SldWorks
Set SwModel = SwApp.ActiveDoc
Dim SwDraw As DrawingDoc
Set SwDraw = SwModel
Dim SwView As View, SwDispDim As DisplayDimension, SwDim As Dimension
Dim SwViewXForm As MathTransform
Dim MathPt As MathPoint, SkPt As SketchPoint
Set SwView = SwDraw.GetFirstView
Dim oScale
oScale = 1 / SwView.ScaleDecimal
''
Do While Not SwView Is Nothing
Set SwViewXForm = SwView.ModelToViewTransform
'Set SwViewXForm = SwViewXForm.Inverse
Set SwDispDim = SwView.GetFirstDisplayDimension
Do While Not SwDispDim Is Nothing
Debug.Print SwView.Name,
Set SwDim = SwDispDim.GetDimension
Debug.Print SwDim.FullName
ss = SwDim.ReferencePoints
For jj = 0 To 2
Set MathPt = ss(jj)
Set MathPt = MathPt.MultiplyTransform(SwViewXForm)
With MathPt
Debug.Print .ArrayData(0) * oScale, .ArrayData(1) * oScale, 0
Set SkPt = SwModel.CreatePoint2(.ArrayData(0) * oScale, .ArrayData(1) * oScale, 0)
End With
Stop
Next jj
Set SwDispDim = SwDispDim.GetNext
Loop
Set SwView = SwView.GetNextView
'Set SwViewXForm = SwViewXForm.Inverse
Loop
End Sub
Are you going to post a question with those snippets of code, or do we have to figure out the question by ourselves? I understand the main question and don't have an answer yet. Please provide some more info.
''
Private Sub ll2()
''
Dim SwApp As SldWorks.SldWorks, SwModel As ModelDoc2
Set SwApp = Application.SldWorks
Set SwModel = SwApp.ActiveDoc
Dim SwMatUtil As MathUtility
Set SwMatUtil = SwApp.GetMathUtility
Dim SwViewXForm As MathTransform
Dim SwDraw As DrawingDoc
Set SwDraw = SwModel
Dim SwView As View
Set SwView = SwDraw.GetFirstView
Set SwView = SwView.GetNextView
Dim SwSketch As Sketch
Set SwSketch = SwModel.GetActiveSketch
Dim SwModelToViewXForm As MathTransform
Dim swModelToSketchXForm As MathTransform
Dim swDrawingToViewXForm As MathTransform
Set SwModelToViewXForm = SwView.ModelToViewTransform
Set swModelToSketchXForm = SwSketch.ModelToSketchTransform
Set swDrawingToViewXForm = DrawingToViewTransform(SwView, SwMatUtil)
'SwDraw.ActivateView SwView.Name
'SwApp.ActiveDoc.ActiveView.FrameState = 1
xx = 0.09 '283462373492
yy = 0.03500318526879
zz = 0
tmp = SwModel.Extension.SelectByID2("", "EDGE", xx, yy, zz, False, 0, Nothing, 0)
Stop
Dim vPt(2) As Double
vPt(0) = xx
vPt(1) = yy
Dim MatPt As MathPoint
Set MatPt = SwMatUtil.CreatePoint(vPt)
Set MatPt = MatPt.MultiplyTransform(SwModelToViewXForm)
With MatPt
Debug.Print .ArrayData(0), .ArrayData(1), zz
SwDraw.CreatePoint .ArrayData(0), .ArrayData(1), zz
SwModel.CreatePoint xx, yy, zz
End With
Stop
''
Set MatPt = SwMatUtil.CreatePoint(vPt)
Set MatPt = MatPt.MultiplyTransform(swModelToSketchXForm)
With MatPt
Debug.Print .ArrayData(0), .ArrayData(1), zz
SwDraw.CreatePoint .ArrayData(0), .ArrayData(1), zz
End With
Stop
''
Set MatPt = SwMatUtil.CreatePoint(vPt)
Set MatPt = MatPt.MultiplyTransform(swDrawingToViewXForm)
With MatPt
Debug.Print .ArrayData(0), .ArrayData(1), zz
SwDraw.CreatePoint .ArrayData(0), .ArrayData(1), zz
End With
Stop
End Sub
Function DrawingToViewTransform(SwView As View, SwMathUtil As MathUtility) As MathTransform
'Dim SwMathUtil As SldWorks.MathUtility
Dim transformData(15) As Double
'Set SwMathUtil = SwApp.GetMathUtility
transformData(0) = 1#
transformData(1) = 0#
transformData(2) = 0#
transformData(3) = 0#
transformData(4) = 1#
transformData(5) = 0#
transformData(6) = 0#
transformData(7) = 0#
transformData(8) = 1#
transformData(9) = SwView.Position(0)
transformData(10) = SwView.Position(1)
transformData(11) = 0#
transformData(12) = 1#
transformData(13) = 0#
transformData(14) = 0#
transformData(15) = 0#
Set DrawingToViewTransform = SwMathUtil.CreateTransform(transformData)
End Function