CAD Forum

Code: Select all

SldWorks.View.ReferencedDocument

Code: Select all

Option Explicit
Sub main()
    Dim swApp As SldWorks.SldWorks
    Dim swModel As SldWorks.ModelDoc2
    Dim swView As SldWorks.View
    Dim swDrawModel As SldWorks.ModelDoc2
    Dim swDraw As SldWorks.DrawingDoc
    
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swDraw = swModel
    
'    Start performance enhancers
    StartNoScreenUpdate swModel
    StartLockFMT swModel
    
'    First view on the sheet (sheet format)
    Set swView = swDraw.GetFirstView
'    first actual view
    Set swView = swView.GetNextView
'    set swdrawmodel to be model that is referenced on the first sheet on the first available view
    Set swDrawModel = swView.ReferencedDocument
    
'    Exit if drawing has no referenced documents
    If swDrawModel Is Nothing Then
        MsgBox ("This drawing has no referenced documents!")
        Exit Sub
    End If

'define what should be changed
Dim propertyName As String
Dim propertyValue As String
propertyname = "some name"
propertyvalue = "some value"

'read out all title block items from drawing
AddProperty swDrawModel , propertyName, propertyValue

' End performance enhancers
    EndNoScreenUpdate swModel
    EndLockFMT swModel
    
End Sub

' adds a property with the name "propertyname" and the value "propertyvalue" to the general tab of the custom properties
Sub AddProperty(swModel As SldWorks.ModelDoc2, propertyName As String, propertyValue As String)
    Dim swModelDocExt As ModelDocExtension
    Dim swCustProp As CustomPropertyManager
    Dim newprop As Boolean

    Set swModelDocExt = swModel.Extension
    Set swCustProp = swModelDocExt.CustomPropertyManager("")

    newprop = swCustProp.Add3(propertyName, swCustomInfoText, propertyValue, swCustomPropertyReplaceValue)
End Sub

'-------------------------------------------------------------------------------------------------------------------
'-------------------------------------------------------------------------------------------------------------------
' Speed up the macro!

Sub StartNoScreenUpdate(swModel As SldWorks.ModelDoc2)
    Dim modView As ModelView
    Set modView = swModel.ActiveView
    modView.EnableGraphicsUpdate = False
End Sub


Sub EndNoScreenUpdate(swModel As SldWorks.ModelDoc2)
    Dim modView As ModelView
    Set modView = swModel.ActiveView
    modView.EnableGraphicsUpdate = True
End Sub


Sub StartLockFMT(swModel As SldWorks.ModelDoc2)
    swModel.FeatureManager.EnableFeatureTree = False
End Sub


Sub EndLockFMT(swModel As SldWorks.ModelDoc2)
    swModel.FeatureManager.EnableFeatureTree = True
End Sub