Code:
Dim cad_obj As ObjectPrivate Type se_dimension
se_d_name As String
se_d_value As Double
se_d_object As Object
End Type
Private Type se_feature
se_f_name As String
se_f_supression As Boolean
se_f_type As Long
se_f_object As Object
End Type
Private Type se_model_info
se_m_i_name As String
se_m_i_path As String
se_m_i_fullname As String
se_m_i_type As Long
se_m_i_author As String
se_m_i_category As String
se_m_i_comments As String
se_m_i_company As String
se_m_i_subject As String
se_m_i_title As String
se_m_i_revision As String
se_m_i_project As String
End Type
Private Type se_model
se_m_features() As se_feature
se_m_dims() As se_dimension
se_m_info As se_model_info
se_m_object As Object
End Type
Dim mymodels() As se_model
Private Function get_models(ByVal root_obj As Object) As se_model()
Dim cur_doc As Object
Dim Docs As Long
Dim dim_arr() As se_model
ReDim dim_arr(0)
If root_obj Is Nothing Then
For Docs = 1 To cad_obj.Documents.Count
traverse_model cad_obj.Documents.Item(Docs), dim_arr
Next Docs
Else
traverse_model root_obj, dim_arr
End If
ReDim Preserve dim_arr(UBound(dim_arr) - 1)
get_models = dim_arr
End Function
Private Sub traverse_model(ByVal root_obj As Object, ByRef dim_arr() As se_model)
Dim d_b As Long
Dim occs As Long
d_b = UBound(dim_arr)
dim_arr(d_b).se_m_info.se_m_i_name = root_obj.Name
dim_arr(d_b).se_m_info.se_m_i_path = root_obj.Path
dim_arr(d_b).se_m_info.se_m_i_fullname = root_obj.FullName
dim_arr(d_b).se_m_info.se_m_i_type = root_obj.Type
dim_arr(d_b).se_m_info.se_m_i_author = root_obj.SummaryInfo.Author
dim_arr(d_b).se_m_info.se_m_i_category = root_obj.SummaryInfo.Category
dim_arr(d_b).se_m_info.se_m_i_comments = root_obj.SummaryInfo.Comments
dim_arr(d_b).se_m_info.se_m_i_company = root_obj.SummaryInfo.Company
dim_arr(d_b).se_m_info.se_m_i_project = root_obj.SummaryInfo.ProjectName
dim_arr(d_b).se_m_info.se_m_i_revision = root_obj.SummaryInfo.RevisionNumber
dim_arr(d_b).se_m_info.se_m_i_subject = root_obj.SummaryInfo.Subject
dim_arr(d_b).se_m_info.se_m_i_title = root_obj.SummaryInfo.Title
Set dim_arr(d_b).se_m_object = root_obj
ReDim Preserve dim_arr(d_b + 1)
If root_obj.Type = 3 Then
For occs = 1 To root_obj.Occurrences.Count
traverse_model root_obj.Occurrences(occs).OccurrenceDocument, dim_arr
Next occs
End If
End Sub
Private Function get_dimensions(ByVal cur_doc As Object) As se_dimension()
Dim cur_pset As Object
Dim cur_prof As Object
Dim cur_dim As Object
Dim psets As Long
Dim profs As Long
Dim dims As Long
Dim dim_arr() As se_dimension
Dim d_b As Long
ReDim dim_arr(0)
If cur_doc.Type = 1 Then
For psets = 1 To cur_doc.ProfileSets.Count
Set cur_pset = cur_doc.ProfileSets(psets)
For profs = 1 To cur_pset.Profiles.Count
Set cur_prof = cur_pset.Profiles(profs)
For dims = 1 To cur_prof.Dimensions.Count
Set cur_dim = cur_prof.Dimensions(dims)
d_b = UBound(dim_arr)
dim_arr(d_b).se_d_name = cur_dim.Name
dim_arr(d_b).se_d_value = cur_dim.Value
Set dim_arr(d_b).se_d_object = cur_dim
ReDim Preserve dim_arr(d_b + 1)
Next dims
Next profs
Next psets
ReDim Preserve dim_arr(UBound(dim_arr) - 1)
get_dimensions = dim_arr
End If
End Function
Private Function get_features(ByVal cur_doc As Object) As se_feature()
Dim cur_feat As Object
Dim feats As Long
Dim dim_arr() As se_feature
Dim d_b As Long
ReDim dim_arr(0)
If cur_doc.Type = 1 Then
For feats = 1 To cur_doc.Models(1).Features.Count
Set cur_feat = cur_doc.Models(1).Features(feats)
d_b = UBound(dim_arr)
dim_arr(d_b).se_f_name = cur_feat.Name
dim_arr(d_b).se_f_supression = cur_feat.Suppress
dim_arr(d_b).se_f_type = cur_feat.Type
Set dim_arr(d_b).se_f_object = cur_feat
ReDim Preserve dim_arr(d_b + 1)
Next feats
ReDim Preserve dim_arr(UBound(dim_arr) - 1)
get_features = dim_arr
End If
End Function
Private Function find_index(ByVal Text As String) As Long
Dim i As Long
For i = 1 To UBound(mymodels)
If mymodels(i).se_m_info.se_m_i_name = Text Then
find_index = i
Exit Function
End If
Next i
find_index = 0
End Function
Private Sub Form_Load()
Dim numModels As Long
Set cad_obj = GetObject(, "SolidEdge.Application")
mymodels = get_models(Nothing)
numModels = UBound(mymodels)
For i = 0 To numModels
mymodels(i).se_m_features = get_features(mymodels(i).se_m_object)
mymodels(i).se_m_dims = get_dimensions(mymodels(i).se_m_object)
Next i
DoEvents
End Sub