Attribute VB_Name = "IPropEintraege"
 
'---------------------------------------------------------------------------------
'(c) Lothar Boekels 2007
'    Boekels Ingenieurbüro für Maschinenbau
'    Schroerskamp 74
'    41069 Mönchengladbach
'    kontakt@boekels-online.de
'---------------------------------------------------------------------------------



Sub Property_Expression_setzen(oDoc As Document, sPropName As String, vExpression As Variant)
' Belegt eine Property mit einem Wert.
' Ist die Property nicht vorhanden, so wird sie angelegt.

    ' Obtain the PropertySets collection object
    Dim oPropSets As PropertySets
    Set oPropSets = oDoc.PropertySets
 
  
    Dim bPropertyDa As Boolean
    Dim oProp As Property
    
    bPropertyDa = False
    
    
    ' Iterate through all the PropertySets one by one using for loop
    ' and changing its value if found
    Dim oPropSet As PropertySet
    For Each oPropSet In oPropSets
    
        For Each oProp In oPropSet
            'Debug.Print oProp.Name
            If oProp.name = sPropName Then
                oProp.Expression = vExpression
                bPropertyDa = True
                Exit For
            End If
        Next
        
    Next
    
  
    'Property anlegen und Wert eintragen
    
    If Not bPropertyDa Then
        oDoc.PropertySets("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}").Add vExpression, sPropName
        'oDoc.PropertySets.Item("User Defined Properties").Add vExpression, sPropName
    End If

  
End Sub
  
'--------------------------------------------------------------------------------------------------

Public Sub Property_setzen(oDoc As Document, sPropName As String, vPropValue As Variant)
' Belegt eine Property mit einem Wert.
' Ist die Property nicht vorhanden, so wird sie angelegt.

    ' Obtain the PropertySets collection object
    Dim oPropSets As PropertySets
    Set oPropSets = oDoc.PropertySets
 
  
    Dim bPropertyDa As Boolean
    Dim oProp As Property
    
    bPropertyDa = False
    
    On Error Resume Next
    
    ' Iterate through all the PropertySets one by one using for loop
    ' and changing its value if found
    Dim oPropSet As PropertySet
    For Each oPropSet In oPropSets
    
        For Each oProp In oPropSet
            'Debug.Print oProp.Name
            If oProp.name = sPropName Then
                oProp.Value = vPropValue
                bPropertyDa = True
                Exit For
            End If
        Next
        
    Next
    
  
    'Property anlegen und Wert eintragen
    
    If Not bPropertyDa Then
        oDoc.PropertySets("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}").Add vPropValue, sPropName
        'oDoc.PropertySets.Item("User Defined Properties").Add vPropValue, sPropName
    End If
    
    On Error GoTo 0
  
End Sub
  
'--------------------------------------------------------------------------------------------------



Public Function Property_lesen(oDoc As Document, sPropName As String) As Variant
' Liest eine Property.
' Ist die Property nicht vorhanden, so wird "" zurückgegeben.

    Property_lesen = ""

If oDoc Is Nothing Then Return


    ' Obtain the PropertySets collection object
    Dim oPropSets As PropertySets
    Set oPropSets = oDoc.PropertySets
 
    Dim oProp As Property
    
    ' Iterate through all the PropertySets one by one using for loop
    Dim oPropSet As PropertySet
    For Each oPropSet In oPropSets
    
        For Each oProp In oPropSet
            'Debug.Print oProp.Name
            If oProp.name = sPropName Then
                Property_lesen = oProp.Value
                Exit For
            End If
        Next
        
    Next

End Function
'--------------------------------------------------------------------------------------------------



Public Sub Property_loeschen(oDoc As Document, sPropName As String)
' Löscht eine Property.

    ' Obtain the PropertySets collection object
    Dim oPropSets As PropertySets
    Set oPropSets = oDoc.PropertySets
    Dim oPropSet As PropertySet
    Dim oProp As Property
    
    Dim bFound As Boolean
    bFound = False
    
    ' Iterate through all the PropertySets one by one using for loop
    
    For Each oPropSet In oPropSets
        For Each oProp In oPropSet
            If oProp.name = sPropName Then
                oProp.Delete
            End If
        Next
    Next

End Sub
  


'--------------------------------------------------------------------------------------------------

Public Sub DelMisusedIProps()
' Löscht falsch benutzte iProperties:
' iProp-Bevollmächtigter 'Authority  : löschen der Volumenangabe - Kennung "mm^3"
' iProp-Kostenstelle     'Cost Center: löschen der Massenangabe  - Kennung " kg"
' iProp-Zulieferer       'Vendor     : löschen der Angabe        - Kennung "Autodesk Inc."
' iProp-TotalMass       : löschen
' iProp-TotalVolume     : löschen
' iProp-SaveDate        : löschen
' iProp-SaveTime        : löschen


    ' Declare the Application object
    Dim oApplication As Inventor.Application

    ' Obtain the Inventor Application object.
    ' This assumes Inventor is already running.
    Set oApplication = GetObject(, "Inventor.Application")

    ' Set a reference to the active document.
    ' This assumes a document is open.
    Dim oDoc As Document
    Set oDoc = oApplication.ActiveDocument
    
    If InStr(1, Property_lesen(oDoc, "Authority"), "mm^3", vbTextCompare) Then
        Call Property_setzen(oDoc, "Authority", "")
    End If
    If InStr(1, Property_lesen(oDoc, "Cost Center"), " kg", vbTextCompare) Then
        Call Property_setzen(oDoc, "Cost Center", "")
    End If
    If Property_lesen(oDoc, "Vendor") = "Autodesk Inc." Then
        Call Property_setzen(oDoc, "Vendor", "")
    End If
    
    Call Property_loeschen(oDoc, "TotalMass")
    Call Property_loeschen(oDoc, "TotalVolume")
    Call Property_loeschen(oDoc, "SaveDate")
    Call Property_loeschen(oDoc, "SaveTime")

End Sub



'--------------------------------------------------------------------------------------------------

  
  
Private Sub test()

      
    ' Declare the Application object
    Dim oApplication As Inventor.Application

    ' Obtain the Inventor Application object.
    ' This assumes Inventor is already running.
    Set oApplication = GetObject(, "Inventor.Application")

    ' Set a reference to the active document.
    ' This assumes a document is open.
    Dim oDoc As Document
    Set oDoc = oApplication.ActiveDocument
    
    Dim vPropValue As Variant
    Dim sPropName As String
    
    sPropName = "Testprop"
    vPropValue = "Test"
    
    Call Property_setzen(oDoc, sPropName, vPropValue)
    
    
    sPropName = "Cost"
    vPropValue = 2.115768172
    
    Call Property_setzen(oDoc, sPropName, vPropValue)
    
    Call Property_Expression_setzen(oDoc, "Testcost", "=<Cost> ksjhfkas")
  
  
    Call Doc_Properties_auslesen(oDoc)
    
    Call Property_loeschen(oDoc, "Testcost")
    Call Property_loeschen(oDoc, "Testprop")
    

    
  
  End Sub
  
'--------------------------------------------------------------------------------------------------

  
 Public Sub Properties_auslesen()
  
      ' Declare the Application object
    Dim oApplication As Inventor.Application

    ' Obtain the Inventor Application object.
    ' This assumes Inventor is already running.
    Set oApplication = GetObject(, "Inventor.Application")

    ' Set a reference to the active document.
    ' This assumes a document is open.
    Dim oDoc As Document
    Set oDoc = oApplication.ActiveDocument
    
  
    Call Doc_Properties_auslesen(oDoc)
  
  
  End Sub
  
   
'--------------------------------------------------------------------------------------------------

 
  Private Sub Doc_Properties_auslesen(oDoc As Document)
  
  
      
    ' Obtain the PropertySets collection object
    Dim oPropSets As PropertySets
    Set oPropSets = oDoc.PropertySets
 
  
    ' Iterate through all the PropertySets one by one using for loop
    Dim oPropSet As PropertySet
    
    Dim oProperty As Property
    
    Debug.Print
    Debug.Print "Properties in " & oDoc.DisplayName
    Debug.Print
    Debug.Print "==============================================================================="
    Debug.Print
    
    For Each oPropSet In oPropSets
    
        ' Obtain the DisplayName of the PropertySet
        Debug.Print "Display name: " & oPropSet.DisplayName

        ' Obtain the InternalName of the PropertySet
        Debug.Print "Internal name: " & oPropSet.InternalName

        ' Write a blank line to separate each pair.
        Debug.Print
   ' Next

    ' Get a reference to the "Design Tracking Properties" PropertySet
    'Dim oPropSet As PropertySet
    'Set oPropSet = oPropsets.Item("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}")
 
  
    'Dim oPropSet As PropertySet
    'For Each oPropSet In oPropsets
        ' Iterate through all the Properties in the current set.
        For Each oProperty In oPropSet
        
            On Error Resume Next
            
            ' Obtain the Name of the Property
            Dim sName As String
            sName = oProperty.name

            ' Obtain the Value of the Property
            Dim vValue As Variant
            vValue = oProperty.Value

            ' Obtain the Expression of the Property
            Dim vExpression As Variant
            vExpression = oProperty.Expression

            ' Obtain the PropertyId of the Property
            Dim PropertyId As Long
            PropertyId = oProperty.PropId
            
            Debug.Print sName; Tab(35); ": " & vValue;
            If VBA.Left$(CStr(vExpression), 1) = "=" Then
                Debug.Print Tab(70); vExpression
            Else
                Debug.Print
            End If
            
            
            If Err.Number <> 0 Then
                Err.Clear
            End If
        Next
        
        Debug.Print
        Debug.Print "- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -"
        Debug.Print
    
    Next
  
  
'--------------------------------------------------------------------------------------------------



End Sub
  
  
  
  
  Private Function Trennzeichen(ByVal Anzahl As Long) As String
    
    Dim ii As Long
    
    Trennzeichen = ""

    For ii = 0 To Anzahl - 1
        
        Trennzeichen = Trennzeichen + " "
        
    Next ii



End Function


Public Sub getPropsFromIdwParent()
    
    If Not ThisApplication.ActiveDocumentType = kDrawingDocumentObject Then
        Exit Sub
    End If
    
    Dim oDrwDoc As Inventor.DrawingDocument
    Set oDrwDoc = ThisApplication.ActiveDocument
    
    If oDrwDoc.ReferencedDocuments.Count = 0 Then
        Exit Sub
    End If
    
    Dim oRefDoc As Inventor.Document
    Set oRefDoc = oDrwDoc.ReferencedDocuments.Item(1)
    
    Const i As Long = 11
    
    Dim iPropName(i) As String
    
    iPropName(1) = "Title"
    iPropName(2) = "Description"
    iPropName(3) = "Description2"
    iPropName(4) = "Subject"
    iPropName(5) = "Part Number"
    iPropName(6) = "Project"
    iPropName(7) = "Halbzeug"
    iPropName(8) = "Company"
    iPropName(9) = "Stock Number"
    iPropName(10) = "Vendor"
    iPropName(11) = "Manufacturer"
    
    For ii = 1 To i
    Call IPropEintraege.Property_setzen(oDrwDoc, iPropName(ii), _
        CStr(IPropEintraege.Property_lesen(oRefDoc, iPropName(ii))))
    Next ii
    
    Set oRefDoc = Nothing
    Set oDrawDoc = Nothing
    Set oApp = Nothing

  
End Sub


Public Sub GetIPropsFromParent()
    
    If Not (ThisApplication.ActiveDocumentType = kDrawingDocumentObject Or _
           ThisApplication.ActiveDocumentType = kPresentationDocumentObject) _
    Then
        Exit Sub
    End If
    
    Dim oTargetDoc As Inventor.Document
    Set oTargetDoc = ThisApplication.ActiveDocument
    
    If oTargetDoc.ReferencedDocuments.Count = 0 Then
        Exit Sub
    End If
    
    Dim oSourceDoc As Inventor.Document
    Set oSourceDoc = oTargetDoc.ReferencedDocuments.Item(1)
    
    Const i As Long = 11
    
    Dim iPropName(i) As String
    
    iPropName(1) = "Title"
    iPropName(2) = "Description"
    iPropName(3) = "Description2"
    iPropName(4) = "Subject"
    iPropName(5) = "Part Number"
    iPropName(6) = "Project"
    iPropName(7) = "Halbzeug"
    iPropName(8) = "Company"
    iPropName(9) = "Stock Number"
    iPropName(10) = "Vendor"
    iPropName(11) = "Manufacturer"
    
    For ii = 1 To i
    Call IPropEintraege.Property_setzen(oTargetDoc, iPropName(ii), _
        CStr(IPropEintraege.Property_lesen(oSourceDoc, iPropName(ii))))
    Next ii
    
    Set oTargetDoc = Nothing
    Set oSourceDoc = Nothing
    Set oApp = Nothing

  
End Sub

Public Sub Description_umtragen()

    Dim oDoc As Inventor.Document
    Set oDoc = ThisApplication.ActiveDocument

    Call Property_setzen(oDoc, "Title", Property_lesen(oDoc, "Description"))


End Sub
  
'--------------------------------------------------------------------------------------------------



Private Sub dummy()

End Sub