Hallo Carsten,
es pressierte ... untenstehend der ausgebaute Code. Besten Dank nochmal.
Private Sub Abgleich_Stückliste(ByVal BOMARRAY)
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swDraw As SldWorks.DrawingDoc
Dim swView As SldWorks.View
Dim swNote As SldWorks.Note
Dim swAnn As SldWorks.Annotation
Dim swEnt As SldWorks.Entity
Dim swComp As SldWorks.Component
Dim swCompModel As SldWorks.ModelDoc2
Dim vAttEntArr As Variant
Dim vConfigNameArr As Variant
Dim vConfigName As Variant
Dim vCustInfoNameArr As Variant
Dim vCustInfoName As Variant
Dim InfoName As Variant
Dim InfoValue As Variant
Dim InfoType As Variant
Dim InfoText As Variant
Dim gesucht As String
Dim Positionsnummer As Variant
Dim bRet As Boolean
gesucht = gesuchter Wert/ Begriff/ Variable
On Error Resume Next
Set swApp = Application.SldWorks
Set swDraw = swApp.ActiveDoc
Set swView = swDraw.GetFirstView
Do While Not swView Is Nothing
Dim TypTest 'Durchlauf verkürzt, Abbruch bei Blattformat
TypTest = swView.Type
Select Case TypTest
Case Is <> 1
Set swNote = swView.GetFirstNote
Do While Not swNote Is Nothing
Dim Check
Check = swNote.IsBomBalloon
Select Case Check
Case True:
Set swAnn = swNote.GetAnnotation
vAttEntArr = swAnn.GetAttachedEntities2
Set swEnt = vAttEntArr(0)
Set swComp = swEnt.GetComponent
Set swCompModel = swComp.GetModelDoc
vConfigNameArr = swCompModel.GetConfigurationNames
If IsEmpty(vConfigNameArr) Then
ReDim vConfigNameArr(0)
vConfigNameArr(0) = ""
Else
ReDim Preserve vConfigNameArr(UBound(vConfigNameArr) + 1)
End If
For Each vConfigName In vConfigNameArr
Dim ConfigName
ConfigName = vConfigName
vCustInfoNameArr = swCompModel.GetCustomInfoNames2(vConfigName)
If Not IsEmpty(vCustInfoNameArr) Then
For Each vCustInfoName In vCustInfoNameArr
InfoName = vCustInfoName
'InfoType = swCompModel.GetCustomInfoType3(vConfigName, vCustInfoName)
InfoValue = swCompModel.GetCustomInfoValue(vConfigName, vCustInfoName)
'InfoText = swCompModel.CustomInfo2(vConfigName, vCustInfoName)
If InfoName = gesucht Then
Dim Postionsnummer As Variant
Dim Check2 As Integer
Call Stücklistenauswertung(InfoValue, Positionsnummer, BOMARRAY, Check2)
Select Case Check2
Case 1:
bRet = swNote.SetBomBalloonText(swNote.SetText(True), _
Positionsnummer, _
swNote.GetBomBalloonTextStyle(False), _
swNote.GetBomBalloonText(False) & "unterer Text"): Debug.Assert bRet
End Select
End If
Next
End If
Next
End Select
Set swNote = swNote.GetNext
Loop
End Select
Set swView = swView.GetNextView
Loop
End Sub
Es werden also alle Views auf vorhandene Stücklistensymbole untersucht.
Weiterhin wird geprüft an welche Komponente/ Modell die Stücklistensymbole angezogen sind.
Aus den Komponenten/ Modelle werden bestimmte benutzerdefinierte Eigenschaften ermittelt (gesucht=...), in meinem Fall eine Artikelnummer.
Mit der Artikelnummer wird eine Stückliste (Excel bzw. BOMARRAY=ausgelesene Stückliste) durchsucht (Call ...).
Nüja, ist vielleicht nicht schön geworden, aber es funktioniert. Anbei das ganze Makro.
------------------
mfg
Patrick
EINFACH sein, einfach SEIN!
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP
Foren auf CAD.de (alle Foren)
| 
