AnsweredAssumed Answered

PROBLEM WITH A MACRO !!!!!

Question asked by Korbi Anis on Jun 12, 2017
Latest reply on Jun 13, 2017 by Christian Chu

Hello friends ! when I tried to run this macro it does not work especially in the line : INSERTREFPLAN !!

THIS THE MACRO :

Set swApp = Application.SldWorks

 

    Set swModel = swApp.ActiveDoc

    Set swModelDocExt = swModel.Extension

 

 

boolstatus = swModelDocExt.SelectByID2("POINTSKETCH@P ROUGE-1@Assemblage2radif", "SKETCH", 0, 0, 0, False, 0, Nothing, 0)

 

 

    Set swSelMgr = swModel.SelectionManager

    Set swFeat = swSelMgr.GetSelectedObject6(1, -1)

    Set swSketch = swFeat.GetSpecificFeature2

    vPoint = swSketch.GetSketchPoints

    swModel.ClearSelection2 True

   

     

    If IsEmpty(vPoint) Then Exit Sub

  

    For i = 0 To UBound(vPoint)

        Set swPOINT = vPoint(i)

        swPOINT.Select4 True, Nothing

Set swSelMgr = swModel.SelectionManager

Set swPOINT = swSelMgr.GetSelectedObject6(1, -1)

    '-------------------------------------------------------SELECT FACE-----------------------------------------------------------'

 

 

Set swApp = Application.SldWorks

Set swModel = swApp.ActiveDoc

Set swAssy = swModel

Set swSelMgr = swModel.SelectionManager

Set swSelData = swSelMgr.CreateSelectData

lMark = 1

Set swComp = swAssy.GetComponentByName("P ROUGE-1")

Set swBody = swComp.GetBody

If (swBody Is Nothing) Then

swApp.SendMsgToUser "Component Body Unavailable."

swApp.SendMsgToUser "Make sure not lightweight or suppressed"

Exit Sub

End If

Set swFace = swBody.GetFirstFace

Do While Not swFace Is Nothing

sCurFaceName = swModel.GetEntityName(swFace)

If sCurFaceName Like "R1" & "*" Then

Set swEnt = swFace

bRet = swEnt.Select4(True, swSelData)

swSelData.mark = lMark

lMark = lMark + 1

End If

Set swFace = swFace.GetNextFace

Loop

Set swSelMgr = swModel.SelectionManager

Set swFace = swSelMgr.GetSelectedObject6(2, -1)

'------------------------------------------------------INSERT REF PLANE ---------------------------------------------------------------------------------'

 

 

 

 

 

 

Set swApp = Application.SldWorks

 

 

 

 

 

 

Set swModel = swApp.ActiveDoc

 

 

Set swModelDocExt = swModel.Extension

 

 

Set swFeatureManager = swModel.FeatureManager

 

 

Set swSelMgr = swModel.SelectionManager

 

 

 

 

 

' Create a constraint-based reference plane

 

 

 

 

 

 

Set swRefPlane = swFeatureManager.InsertRefPlane(4, 0, 1, 0, 0, 0) 

 

 

 

 

 

 

 

  Next i

 

 

 

Thanks !!!

Outcomes