Hallo ihr API`ler!
Folgendes Problem, vor Weihnachten entstand folgendes Makro, damals passte alles! Makro wurde erprobt und funktionierte soweit!
Seit diesem Jahr, gibt die Zeile
"void = swCustBendAllow.BendTableFile = Pfadkomplett"
nur noch False zurück!
Keine Ahnung wie sich die Randbedingungen genau geändert haben, der neue Pfad ist korrekt!
Wäre toll wenn jemand eine Idee oder Anregung hätte!
Danke im Voraus, Gruß Sebastian
Dim swApp As Object
Dim Part As Object
Dim SelMgr As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Dim Feature As Object
Dim swCustBend As SldWorks.CustomBendAllowance
Dim swCust As SldWorks.CustomBendAllowance
Dim swSheetMetal As SldWorks.SheetMetalFeatureData
Dim NeuerPfad As String
Sub main()
'----------------------------------------------------------------------------------------------------------------
'----------------------------------------------------------------------------------------------------------------
'Neuer Pfad für Biegetabelle z.B.: N:\cad\Vorlagen\SWX
\Biegetabellen
NeuerPfad = "S:\Einstellungen\Biegetabellen"
'----------------------------------------------------------------------------------------------------------------
'----------------------------------------------------------------------------------------------------------------
Set swApp = CreateObject("SldWorks.Application")
Set swModel = swApp.ActiveDoc
Set retval = swModel.FirstFeature()
Do While Not retval Is Nothing
Name = retval.Name
typ = retval.GetTypeName()
If Not typ = "SheetMetal" Then GoTo 123
boolstatus = swModel.Extension.SelectByID2(Name, "BODYFEATURE", 0, 0, 0, False, 0, Nothing, 0)
If boolstatus = False Then
MsgBox "Dieses Makro funktioniert nur bei Blechbauteilen!"
Exit Sub
End If
Set swSelMgr = swModel.SelectionManager
Set swSelData = swSelMgr.CreateSelectData
Set swFeat = swSelMgr.GetSelectedObject5(1)
Set swsketchbend = swFeat.GetDefinition
Set swCustBendAllow = swsketchbend.GetCustomBendAllowance
'------------------------------ Biegetabellenpfad auslesen -----------------------------------
Dim BendTableFile As String
BendTableFile = swCustBendAllow.BendTableFile()
' schneidet aus der Verzeichnis-String alle Zeichen bis zum Dateinamen ab
c = BendTableFile
Do While Not Status = True
b = Mid(c, InStr(c, "\") + 1)
If c = b Then
Status = True
End If
c = b
Loop
Biegetabelle = c
Pfadkomplett = NeuerPfad + "\" + "PR_Aluminium.btl" ' Biegetabelle
If BendTableFile = Pfadkomplett Then
MsgBox "Alter und neuer Pfad sind identisch, es erfolgt keine Umstellung!"
Exit Sub
End If
'------------------------------- Biegetabellenpfad setzen ------------------------------------
void = swCustBendAllow.BendTableFile = Pfadkomplett
'If void = False Then
' MsgBox "Pfadumstellung nicht erfolgreich bitte Pfad und Tabellenname überprüfen!"
' Exit Sub
'End If
swsketchbend.SetCustomBendAllowance (swCustBendAllow)
bRet = swFeat.ModifyDefinition(swsketchbend, swModel, Nothing)
void = swCustBendAllow.BendTableFile = Pfadkomplett
MsgBox "Pfadumstellung der Biegetabelle erfolgreich abgeschlossen!"
123
Set retval = retval.GetNextFeature()
Loop
End Sub
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP
Foren auf CAD.de (alle Foren)
| 
