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
