×
INTELLIGENT WORK FORUMS
FOR ENGINEERING PROFESSIONALS

Log In

Come Join Us!

Are you an
Engineering professional?
Join Eng-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!
  • Students Click Here

*Eng-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

Jobs

load & activate a model from VB (2)

load & activate a model from VB (2)

load & activate a model from VB (2)

(OP)
Andrew:

Here is the updated sample. If the referenced model is already open, it will remain open. The model will only be closed if the program had to open it.

Option Explicit
'<><><><><><><><><><><><><><>
' Transfer Custom Properties
'<><><><><><><><><><><><><><>
Dim swApp As Object
Dim Dwg As Object
Dim View As Object
Dim Model As Object

Const swDocDRAWING = 3

Dim sModelName As String
Dim sPartName As String
Dim sDwgName As String

Sub Main()
    Dim swError As Long, iPos As Long, bClose As Boolean
    Dim sTitle As String
    Set swApp = CreateObject("SldWorks.Application")
    Set Dwg = swApp.ActiveDoc
    'Verify a Drawing is Open
    If (Dwg Is Nothing) Or (Dwg.GetType <> swDocDRAWING) Then
        swApp.SendMsgToUser "You Must Have a Drawing Opened"
        Exit Sub
    End If
    sDwgName = Dwg.GetTitle
    'Get Reference Model
    Set View = Dwg.GetFirstView    'drawing template
    Set View = View.GetNextView     'first drawing view
    sModelName = View.GetReferencedModelName()
    'Open the Reference Model, read the custom properties, save and close the model
    'Switch to the model if it is already opened
    sPartName = sModelName
    iPos = InStr(1, sPartName, "\")
    Do While iPos > 0
        sPartName = Right(sPartName, Len(sPartName) - iPos)
        iPos = InStr(1, sPartName, "\")
    Loop
    On Error Resume Next
    Set Model = swApp.ActivateDoc(sPartName)
    If Err.Number <> 0 Then     'file is not currently opened
        Err.Clear
        bClose = True
    Else
        bClose = False
    End If
    Set Model = swApp.ActivateDoc2(sModelName, True, swError)
    swApp.SendMsgToUser "Get the Custom Properties"
    Model.Save2 True
    If bClose = True Then   'only close if we had to open it
        swApp.CloseDoc sModelName
    End If
    Set Dwg = swApp.ActivateDoc(sDwgName)
    'Rebuild the drawing
    swApp.SendMsgToUser "Write the Custom Properties to the Drawing"
    Dwg.EditRebuild
    'Clean Up
    Set Model = Nothing
    Set View = Nothing
    Set Dwg = Nothing
    Set swApp = Nothing
End Sub

Hope this helps!

DimensionalSolutions@Core.com
While I welcome e-mail messages, please post all thread activity in these forums for the benefit of all members.

RE: load & activate a model from VB (2)

It helps, thank you.

One little problem. bClose never becomes True so the solid model would stay open even if was closed before.

What sets Err.Number be <> 0?

Andrew

RE: load & activate a model from VB (2)

(OP)
Andrew:

You are correct. I was expecting ActivateDoc to error if the file was not already opened.

Remove this code:

On Error Resume Next
    Set Model = swApp.ActivateDoc(sPartName)
    If Err.Number <> 0 Then     'file is not currently opened
        Err.Clear
        bClose = True
    Else
        bClose = False
    End If

Add this code:

    Dim sTmp As String, nextDoc As Object

    On Error Resume Next
    Set nextDoc = swApp.GetFirstDocument
    sTmp = nextDoc.GetTitle
    bClose = True               'assume file is not open
    Do While sTmp <> ""
        If InStr(1, sTmp, sPartName) > 0 Then
            If nextDoc.Visible = True Then
                bClose = False  'document is already opened
            Else
                bClose = True   'document is not open yet
            End If
            Exit Do
        End If
        Set nextDoc = nextDoc.GetNext
        sTmp = nextDoc.GetTitle
        If Err.Number <> 0 Then Exit Do
    Loop

DimensionalSolutions@Core.com
While I welcome e-mail messages, please post all thread activity in these forums for the benefit of all members.

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Eng-Tips Forums free from inappropriate posts.
The Eng-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Eng-Tips forums is a member-only feature.

Click Here to join Eng-Tips and talk with other members!


Resources