0 Replies Latest reply on Nov 19, 2014 6:48 AM by Manikandan Babu

    Transform

    Manikandan Babu

      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