clsmoldedface.cls

solidworks 2007 二次开发

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsMoldedFace"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Description = "Additional attributes attached to part faces to indicate their moldability.  Set face color based on this moldability."
Attribute VB_Ext_KEY = "SavedWithClassBuilder" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
Option Explicit

'local variable(s) to hold property value(s)
Private mvarStatus As Integer 'local copy
Private mvarSWface As Object 'local copy
Private mvarFaceType As Integer 'local copy

' local variables in class
Private OriginalColor As Variant ' holds original color to return to

' 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

'Public Property Let FaceType(ByVal vData As Integer)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.FaceType = 5
'    mvarFaceType = vData
'End Property


Public Property Get FaceType() As Integer
Attribute FaceType.VB_Description = "Geometric type of face.  Plane, cylinder, etc..  Will determine method used to calculate moldability"
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.FaceType
    FaceType = mvarFaceType
End Property

Public Function SetToStatusColor() As Integer
Attribute SetToStatusColor.VB_Description = "Determine moldability of surface based on pull plane direction.  And set  its color accordingly"

    Dim NewColor(8) As Double
    Dim i As Integer
    
    '
    ' Determine the status of the current face
    '
    If mvarSWface.GetSurface.Identity = 4001 Then
    '
    ' If this face is a PLANE then
    '
        SetStatusForPlane
        
    Else
    '
    ' surface is anything else except a plane
    '
        SetStatusForGeneralSurfaces
        
    End If
    
    
    '
    ' Set color of face based on status
    '
    If IsEmpty(OriginalColor) Then
        
        'face is currently the color of the body
        ColorTemplate(0) = StatusRed(mvarStatus)
        ColorTemplate(1) = StatusGreen(mvarStatus)
        ColorTemplate(2) = StatusBlue(mvarStatus)
        mvarSWface.MaterialPropertyValues = ColorTemplate
        
    Else
    
        'the face does have a custom color set
        For i = 3 To 8
            NewColor(i) = OriginalColor(i)
        Next i
        NewColor(0) = StatusRed(mvarStatus)
        NewColor(1) = StatusGreen(mvarStatus)
        NewColor(2) = StatusBlue(mvarStatus)
        mvarSWface.MaterialPropertyValues = NewColor
    
    End If
    
End Function

Sub SetStatusForPlane()

    Dim UnitNormal As Variant
    Dim DotProduct, NormalAngle As Double
    
    '
    ' Determine the status of the current face
    '
    UnitNormal = mvarSWface.Normal ' get the suface normal
    DotProduct = UnitNormal(0) * PullDirection.VectorX + UnitNormal(1) * PullDirection.VectorY + UnitNormal(2) * PullDirection.VectorZ
    NormalAngle = ArcCos(DotProduct) * 180 / 3.14159 ' return angle in degrees
    NormalAngle = Int(NormalAngle * 10000) / 10000 ' keep 4 significant digits
    If NormalAngle > 180 Then
        NormalAngle = 360 - NormalAngle ' limit value to between 0 - 180
    End If
        
    If NormalAngle = 90 Then
        mvarStatus = NO_DRAFT
        
    ElseIf NormalAngle <= (90 - PullDirection.MinDraftAngle) Then
        mvarStatus = DIREC_1
            
    ElseIf NormalAngle > (90 - PullDirection.MinDraftAngle) And NormalAngle < 90 Then
        mvarStatus = MARGINAL_1
            
    ElseIf NormalAngle > 90 And NormalAngle < (90 + PullDirection.MinDraftAngle) Then
        mvarStatus = MARGINAL_2
            
    Else
        mvarStatus = DIREC_2
            
    End If

End Sub

Sub SetStatusForGeneralSurfaces()

    Dim Normals As Variant
    Dim TotalFacets As Long
    Dim NormalX, NormalY, NormalZ As Double
    Dim Magnitude As Double
    Dim i As Long
    Dim NextSet As Long

    Dim Direc1 As Boolean
    Dim Marg1 As Boolean
    Dim NoDraft As Boolean
    Dim Marg2 As Boolean
    Dim Direc2 As Boolean
    Dim Both As Boolean
    Dim DotProduct As Double
    Dim NormalAngle As Double
    
    Direc1 = False
    Marg1 = False
    NoDraft = False
    Marg2 = False
    Direc2 = False
    Both = False
    
    TotalFacets = mvarSWface.GetTessTriangleCount
    Normals = mvarSWface.GetTessNorms
    
    For i = 1 To TotalFacets ' for each facet on the face
    
        NextSet = (i - 1) * 9
        ' add 3 normals at each vertex together to get resultant vector (avg. direction)
        NormalX = Normals(NextSet) + Normals(NextSet + 3) + Normals(NextSet + 6)
        NormalY = Normals(NextSet + 1) + Normals(NextSet + 4) + Normals(NextSet + 7)
        NormalZ = Normals(NextSet + 2) + Normals(NextSet + 5) + Normals(NextSet + 8)
        Magnitude = Sqr(NormalX * NormalX + NormalY * NormalY + NormalZ * NormalZ)
        ' turn into a unit vector
        NormalX = NormalX / Magnitude
        NormalY = NormalY / Magnitude
        NormalZ = NormalZ / Magnitude
        
        DotProduct = NormalX * PullDirection.VectorX + NormalY * PullDirection.VectorY + NormalZ * PullDirection.VectorZ
        
        ' Ensure absolute value of DotProduct not > 1 (round off errors)
        If DotProduct > 1 Then
            DotProduct = 1
        ElseIf DotProduct < -1 Then
            DotProduct = -1
        End If
        
        NormalAngle = ArcCos(DotProduct) * 180 / 3.14159 ' return angle in degrees
        NormalAngle = Int(NormalAngle * 10000) / 10000 ' keep 4 significant digits
        If NormalAngle > 180 Then
            NormalAngle = 360 - NormalAngle ' limit value to between 0 - 180
        End If
        
        If NormalAngle = 90 Then
            NoDraft = True
        
        ElseIf NormalAngle <= (90 - PullDirection.MinDraftAngle) Then
            Direc1 = True
            
        ElseIf NormalAngle > (90 - PullDirection.MinDraftAngle) And NormalAngle < 90 Then
            Marg1 = True
            
        ElseIf NormalAngle > 90 And NormalAngle < (90 + PullDirection.MinDraftAngle) Then
            Marg2 = True
            
        Else
            Direc2 = True
            
        End If
        
        If (Direc1 Or Marg1) And (Direc2 Or Marg2) Then
        
            ' The surface has normals pointing in both directions, no additional
            ' calculations needed on this surface
            mvarStatus = BOTH_1_2
            Exit Sub
            
        End If
        
    Next i ' for each facet on the face
    
    ' Set surface status based on worst case found
    If NoDraft Then
        mvarStatus = NO_DRAFT
        
    ElseIf Marg1 Then
        mvarStatus = MARGINAL_1
        
    ElseIf Marg2 Then
        mvarStatus = MARGINAL_2
        
    ElseIf Direc1 Then
        mvarStatus = DIREC_1
        
    Else
        mvarStatus = DIREC_2
        
    End If
    
End Sub

Public Sub ReturnOriginalColor()
Attribute ReturnOriginalColor.VB_Description = "Set the display status of the SW surface back to its original before the application ends"

    Dim OK As Boolean
    Dim faceName As String

    If IsEmpty(OriginalColor) Then
        'mvarSWface.MaterialPropertyValues = OrigPartColor
        OK = mvarSWface.Select(False)
        faceName = ModabilityMain.Part.GetEntityName(mvarSWface)
        OK = ModabilityMain.Part.SelectedFaceProperties(0, 0, 0, 0, 0, 0, 0, True, faceName)
        
    Else
        mvarSWface.MaterialPropertyValues = OriginalColor
    
    End If

End Sub

Public Property Set SWface(ByVal vData As Object)
Attribute SWface.VB_Description = "SW face object which is being evaluated"
'used when assigning an Object to the property, on the left side of a Set statement.
'Syntax: Set x.SWface = Form1
    Set mvarSWface = vData
End Property


Public Property Get SWface() As Object
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.SWface
    Set SWface = mvarSWface
End Property



Public Sub SaveOriginalColor()
Attribute SaveOriginalColor.VB_Description = "Saves original face display properties, so they can be restored before the program exits"

    OriginalColor = mvarSWface.MaterialPropertyValues
    
End Sub

'Public Property Let Status(ByVal vData As Integer)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.Status = 5
'    mvarStatus = vData
'End Property


Public Property Get Status() As Integer
Attribute Status.VB_Description = "Moldability of surface based on pull plane direction"
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.Status
    Status = mvarStatus
End Property

Function ArcCos(ByVal X As Double)

    X = Int(X * 100000000) / 100000000 ' go to 8 significant digits
    
    If X = 1 Then
        ArcCos = 0 ' 0 degrees
    ElseIf X = -1 Then
        ArcCos = 3.14159 'pi - 180 degrees
    Else
        ArcCos = Atn(-X / Sqr(-X * X + 1)) + 2 * Atn(1)
    End If

End Function