API to open all components - debug help VB 6
Joe Jones
components and sub-assemblies of an assembly. I have commented out 2 lines
to make the code run. When the two lines are uncommented, I get errors
trying get the component's properties (hidden, suppressed, name, etc).
Perhaps another set of eyes will help. Please have a look.
The program opens components fine, but hangs up on sub-assemblies. It will
parse through the subs and open children components, but crashes if I allow
it to open the sub-assemblies.
The code is activated by the Form_Load() event.
|===========================================
| Joe Jones j...@nhcad.com
|
| New Hampshire CAD http://www.nhcad.com
| Lebanon, NH 03766
|
| Mechanical Design and Custom Programming
| SolidWorks Research Partner
| Online SolidWorks API Tutorial
|===========================================
' This module will only work against SW assembly files.
' It will open all compoents (or sub-assemblies) of an
' assembly and make it the active window before
' opening the next sub-assembly or component.
Dim swApp As Object
Dim modelDoc As Object
Dim rootComponent As Object
Dim originalFileName As String
Private Sub Form_Load()
Dim drawingDoc As Object
Dim view As Object
Dim configName As String
Set swApp = GetObject(, "SldWorks.Application")
Set modelDoc = swApp.ActiveDoc
If modelDoc Is Nothing Then ' if no SW part is loaded
MsgBox ("This command only works with assemblies")
Exit Sub ' will only work with assembly files
End If
If modelDoc.GetType = 2 Then ' assembly
'On Error GoTo NotSaved:
originalFileName = Left(modelDoc.GetTitle, Len(modelDoc.GetTitle) -
7)
Unique_Components
Else
MsgBox ("This command only works with assemblies")
End If
Unload Form1
NotSaved:
On Error GoTo 0
MsgBox ("ERROR" + Chr(13) + Chr(13) + "This error may be caused because"
+ _
"the assembly file has not been saved. Save the file and try
again")
End Sub
Public Sub Unique_Components()
Dim configuration As Object
Dim I As Integer
Dim J As Integer
Dim Children As Variant
Dim Child As Object
Dim ChildCount As Integer
Set modelDoc = swApp.ActiveDoc
Set configuration = modelDoc.GetActiveConfiguration()
Set rootComponent = configuration.GetRootComponent()
' Recursively traverse the component - If this is an assembly
If rootComponent Is Nothing Then
MsgBox ("This program is intended to work with an assembly")
Else
TraverseComponent rootComponent
End If
End Sub
Public Function TraverseComponent(Component As Object)
' Recursive routine to traverse all the children of a component
Dim I As Integer
Dim J As Integer
Dim K As Integer
Dim Children As Variant
Dim Child As Object
Dim ChildCount As Integer
Dim partName As String
'swComponentSuppressed = 0
'swComponentLightweight = 1
'swComponentFullyResolved = 2
If Component.IsHidden(True) = True Then Exit Function
If Component.GetSuppression = 0 Then Exit Function
' Traverse the children
Children = Component.GetChildren ' Get the list of children
ChildCount = UBound(Children)
' count how many "/" there are
J = 0
For K = 1 To Len(Component.Name)
If Mid(Component.Name, K, 1) = "/" Then J = J + 1
Next K
' example:
' section0/section1/section2 where Assem4 is the current (parent) part
' Assem3-1/Peg board2-1/peg-3 has 3 sections. J = 2
' need to create a part name like:
' Assem3-1@Assem4/Peg board2-1@Assem3/Peg-3@Peg board2
partName = ""
For K = 0 To J
' develop part's name
If Len(partName) <> 0 Then partName = partName + "/"
partName = partName + compSection(K, Component.Name) + "@" + _
Left(compSection(K - 1, Component.Name), FindLast(compSection(K - 1,
Component.Name), "-") - 1)
Next K
' open the component called "partName"
If ChildCount = -1 Then ' must be a part file
modelDoc.SelectByID partName, "COMPONENT", 0, 0, 0
modelDoc.OpenCompFile
Else ' must be a subassembly
'
'************** ERRORS ERRORS ERRORS ERRORS
****************************
'
' UNCOMMENTING THE 2 LINES BELOW WILL CAUSE ERRORS
'modelDoc.SelectByID partName, "COMPONENT", 0, 0, 0
'modelDoc.OpenCompFile
'
'***************************************************************************
******
End If
' recursively open children if they exist
For I = 0 To (ChildCount) ' For each Child in this subassembly
Set Child = Children(I) ' Get Child component object
TraverseComponent Child ' Traverse the child's components
Next I
End Function
Public Function compSection(Section As Integer, compname As String) As
String
Dim J As Integer
Dim K As Integer
Dim sectionCnt As Integer
Dim modelDoc As Object
If Section = -1 Then
compSection = originalFileName + "-1"
Exit Function
End If
compSection = ""
sectionCnt = 0
For J = 1 To Len(compname)
If Mid(compname, J, 1) = "/" Then
sectionCnt = sectionCnt + 1
J = J + 1
End If
If sectionCnt = Section Then
compSection = compSection + Mid(compname, J, 1)
End If
Next J
End Function
Public Function FindLast(Str, Chr) As Integer
Dim A, B As Integer
A = 0
B = 0
If InStr(1, Str, Chr) Then
Do Until A = 0 And B <> 0
B = A
A = InStr(A + 1, Str, Chr)
Loop
End If
FindLast = B
End Function
Private Sub Form_Unload(Cancel As Integer)
End
End Sub
John Desmond
>
> '************** ERRORS ERRORS ERRORS ERRORS ****************
> ' UNCOMMENTING THE 2 LINES BELOW WILL CAUSE ERRORS
> 'modelDoc.SelectByID partName, "COMPONENT", 0, 0, 0
> 'modelDoc.OpenCompFile
> '
>
Do you need to make your subassembly ModelDocs active after opening them?
It's not clear from the API help that OpenCompFile will make a newly loaded
document active. The fact that the example provided in the help calls
IActivateDoc right after loading would point toward this also.
John
Joe Jones
I think you are confusing OpenCompFile with OpenDocSilent. OpenDocSilent
does require ActivateDoc.
OpenCompFile does not require me to make the component active. It may turn
out that I will have to use OpenDocSilent and ActivateDoc in order to get my
program running.
AssemblyDoc::OpenCompFile
This method will open the selected assembly component file. The selected
component file will be loaded or made the active document if it is already
loaded.
Joe J
John Desmond <des...@immdesign.com> wrote in message
news:37A1A12C...@immdesign.com...