modabilitymain.bas

solidworks 2007 二次开发

Attribute VB_Name = "ModabilityMain"
Dim swApp As Object
Public Part As Object
Public PullDirection As New clsPullDirection
Dim BodyFace() As New clsMoldedFace
Dim TotalFaces As Long
Public ColorTemplate As Variant ' Color settings of the part body
Public OrigPartColor(8) As Double
Public StatusRed(6), StatusGreen(6), StatusBlue(6) As Double ' Status color map

' Possible status values for surfaces
Const DIREC_1 = 0   ' good for direction 1
Const MARGINAL_1 = 1    ' surface in direc 1, but not enough draft
Const NO_DRAFT = 2  ' surface perfectly aligned along pull direc
Const MARGINAL_2 = 3    ' surface in direc 2, but not enough draft
Const DIREC_2 = 4   ' good for direction 2
Const BOTH_1_2 = 5  ' surface points in both directions, may need slider in mold


Sub GetSWobject()
'
' Set the SolidWorks object and document varialbes
'
    Dim i As Integer
    
    Set swApp = CreateObject("SldWorks.Application")
    Set Part = swApp.ActiveDoc
    
    If Part Is Nothing Then     ' Check to see if a document is loaded.
    
        MsgBox ("Error. No Active Document!")
        End                     ' If no model currently loaded, then exit
        
    End If

    ColorTemplate = Part.MaterialPropertyValues ' get the color settings for the part
    
    For i = 0 To 8 ' save the original part color
        OrigPartColor(i) = ColorTemplate(i)
    Next i
    
    SetStatusColorMap ' set the arrays which define status colors
    
End Sub

Function GetPullDirection(MinAngle As Double) As Boolean
    
    GetPullDirection = PullDirection.SetNormalDirection(Part)
    
    If GetPullDirection Then
        PullDirection.MinDraftAngle = MinAngle
    
    End If
    
End Function

Sub FindMoldLock()

    Dim CurrentFace As Long
    Dim iStatus As Integer
    Dim PartBody As Object
    
    Set PartBody = Part.Body
    TotalFaces = PartBody.GetFaceCount
    ReDim BodyFace(TotalFaces) As New clsMoldedFace
    
    CurrentFace = 1
    Set BodyFace(CurrentFace).SWface = PartBody.GetFirstFace
    Do
        BodyFace(CurrentFace).SaveOriginalColor
        iStatus = BodyFace(CurrentFace).SetToStatusColor
        Part.GraphicsRedraw2
        
        CurrentFace = CurrentFace + 1
        
        If CurrentFace <= TotalFaces Then
            Set BodyFace(CurrentFace).SWface = BodyFace(CurrentFace - 1).SWface.GetNextFace
        End If
        
    Loop While CurrentFace <= TotalFaces
End Sub

Sub RestoreSurfaceColors()
    
    Dim i As Integer
   
   'Part.MaterialPropertyValues = OrigPartColor
   
    For i = 1 To TotalFaces
        BodyFace(i).ReturnOriginalColor
        
    Next i
    
    Part.GraphicsRedraw2
    
End Sub

Sub SetStatusColorMap()

    ' Good for surfaces pointing in direction 1 - Green
    StatusRed(DIREC_1) = 0
    StatusGreen(DIREC_1) = 1
    StatusBlue(DIREC_1) = 0
    
    ' surface in direc 1, but not enough draft - Bronze
    StatusRed(MARGINAL_1) = 0.5
    StatusGreen(MARGINAL_1) = 0.5
    StatusBlue(MARGINAL_1) = 0
    
    ' surface perfectly aligned along pull direc - Orange
    StatusRed(NO_DRAFT) = 1
    StatusGreen(NO_DRAFT) = 0.5
    StatusBlue(NO_DRAFT) = 0
    
    ' surface in direc 2, but not enough draft - Cyan
    StatusRed(MARGINAL_2) = 0
    StatusGreen(MARGINAL_2) = 1
    StatusBlue(MARGINAL_2) = 1
    
    ' good for direction 2 - Blue
    StatusRed(DIREC_2) = 0
    StatusGreen(DIREC_2) = 0
    StatusBlue(DIREC_2) = 1
    
    ' surface points in both directions, may need slider in mold - Magenta
    StatusRed(BOTH_1_2) = 1
    StatusGreen(BOTH_1_2) = 0
    StatusBlue(BOTH_1_2) = 1
    
End Sub

Sub LockUI()
'
' Ensure the part is not modified
'
    Part.SetBlockingState 2
    
End Sub

Sub UnLockUI()
'
' Allow modifications to the part
'
    Part.ResetBlockingState

End Sub