Transform

How to transform the sketch points to assembly drawing view.                                        

Sketch points is inside the  part accompanied in assembly.

Place the block in drawing view with reference to sketch point..

reference. Below macro is fine for if sketch in front plane. Now I transferred sketch plane from front to top now its not working.. Please help me to resolve this ..otherwise any other suggestion.

Option Explicit

Dim swApp As SldWorks.SldWorks

Dim swmodel As SldWorks.ModelDoc2

Dim swsel As SldWorks.SelectionMgr

Dim swview As SldWorks.View

Dim swdrw As SldWorks.DrawingDoc

Dim swfeat As SldWorks.Feature

Dim swskt As SldWorks.Sketch

Dim swpt As SldWorks.SketchPoint

Dim swmath As SldWorks.MathUtility

Dim swmtrans As SldWorks.MathTransform

Dim swmpt As SldWorks.MathPoint

Dim swblk As SldWorks.SketchBlockDefinition

Dim swblkinst As SldWorks.SketchBlockInstance

Dim sktmgr As SldWorks.SketchManager

Dim swdcomp As SldWorks.DrawingComponent

Dim swcomp As SldWorks.Component2

Dim vpos As Variant

Dim fpath As String

Dim vpt(2) As Double

Dim vbpt(2) As Double

Dim vmpt As Variant

Dim vapt As Variant

Dim bret As Boolean

Dim vSkPtArr                As Variant

Dim vSkPt                   As Variant

Dim i As Long

Dim p As Integer

Dim scaledec As Double

Dim vRelation As Variant

Dim count  As Integer

Dim swSkRel As SldWorks.SketchRelation

Dim vSkRel  As Variant

Dim vBlockDef                   As Variant

Dim vBlockInst                  As Variant

Dim swBlockDef                  As SldWorks.SketchBlockDefinition

Dim swBlockInst                 As SldWorks.SketchBlockInstance

Dim insPt As SldWorks.MathPoint

Dim vInstPt As Variant

Dim j As Integer

Sub main()

Set swApp = Application.SldWorks

Set swmodel = swApp.ActiveDoc

Set swsel = swmodel.SelectionManager

Set swdrw = swmodel

swmodel.DeSelectByID "Sheet1", "SHEET", 0, 0, 0

Set sktmgr = swmodel.SketchManager

Set swfeat = swsel.GetSelectedObject5(1)

Set swskt = swfeat.GetSpecificFeature

Set swview = swsel.GetSelectedObjectsDrawingView2(1, 0)

Set swmath = swApp.GetMathUtility

vpos = swview.Position

scaledec = swview.ScaleDecimal

Set swdcomp = swsel.GetSelectedObject5(2)

Set swcomp = swdcomp.Component

swmodel.ClearSelection2 True

swmodel.Extension.SelectByID2 "test", "SUBSKETCHDEF", 0, 0, 0, False, 0, Nothing, 0

swmodel.EditDelete

vSkPtArr = swskt.GetSketchPoints2

For p = 0 To UBound(vSkPtArr)

Set swpt = vSkPtArr(p)

Dim swent As SldWorks.Entity

Dim ep As SldWorks.EdgePoint

Set ep = swent

Set swent = ep

count = swpt.GetRelationsCount

If count > 0 Then

vRelation = swpt.GetRelations

For Each vSkRel In vRelation

Set swSkRel = vSkRel

vpt(0) = swpt.X

vpt(1) = swpt.Y

vpt(2) = swpt.Z

'' Sketch Point location in assembly

Set swmpt = swmath.CreatePoint(vpt)

Set swmtrans = swcomp.Transform2

Set swmpt = swmpt.MultiplyTransform(swmtrans)

vapt = swmpt.ArrayData

'' Sketch Point location in drawing

Set swmtrans = swview.ModelToViewTransform

Set swmpt = swmpt.MultiplyTransform(swmtrans)

vmpt = swmpt.ArrayData

'' Calculate block insert point

vbpt(0) = (vmpt(0) / scaledec) - (vpos(0) / scaledec)

vbpt(1) = (vmpt(1) / scaledec) - (vpos(1) / scaledec)

Set swmpt = swmath.CreatePoint(vbpt)

fpath = swApp.GetCurrentMacroPathFolder

swdrw.ActivateView (swview.Name)

sktmgr.MakeSketchBlockFromFile swmpt, "C:\My data\test\test.SLDBLK", False, 1, 0

swmodel.GraphicsRedraw2

swview.SelectEntity swent, False

Next

End If

Next p

'Add the relation

vBlockDef = sktmgr.GetSketchBlockDefinitions

    If Not IsEmpty(vBlockDef) Then

        For i = 0 To UBound(vBlockDef)

            Set swBlockDef = vBlockDef(i)

swmodel.ClearSelection2 True

vBlockInst = swBlockDef.GetInstances

Dim k As Integer

k = 0

If Not IsEmpty(vBlockInst) Then

For j = 0 To UBound(vBlockInst)

swmodel.ClearSelection2 True

Set swBlockInst = vBlockInst(j)

Set insPt = swBlockDef.InsertionPoint

vInstPt = insPt.ArrayData

swmodel.Extension.SelectByID2 "Insertion Point/" & swBlockInst.Name, "SKETCHPOINT", 0, 0, 0, True, 0, Nothing, 0

swview.SelectEntity swent, False

swmodel.SketchAddConstraints "sgCOINCIDENT"

swmodel.ForceRebuild3 True

k = k + 1

Next j

End If

Next i

End If

MsgBox ("Completed")

End Sub 

SolidworksApi macros