Code:
Sub CATMain()' Set the CATIA popup file alerts to False
' It prevents to stop the macro at each alert during its execution
CATIA.DisplayFileAlerts = False
' Set the file system object containig the folder
Dim oFileSys As FileSystem
Set oFileSys = CATIA.FileSystem
'Define the path's folder where we are looking for Parts
Dim sFolderPath As String
sFolderPath = InputBox( "Enter a folder path:", "Create Drawings", _
sDocPath & "input Folder Path")
If (Not oFileSys.FolderExists(sFolderPath)) Then
Err.Raise 9999,,sFolderPath & ": This Folder does not exist"
End If
'Define the path's folder where we are saving drawings
Dim sFolderPathOut As String
sFolderPathOut = InputBox( "Enter a output folder path:", "Save Drawings", _
sDocPath & "output Folder Path")
If (Not oFileSys.FolderExists(sFolderPathOut)) Then
Err.Raise 9999,,sFolderPath & ": This Folder does not exist"
End If
' Set the folder object
Dim oFolder As Folder
Set oFolder = oFileSys.GetFolder(sFolderPath)
' Loop on the files collection of the folder
' For Each File In Folder.Files
Dim iI
For iI = 1 To oFolder.Files.Count
Dim oFile As Object
Set oFile = oFolder.Files.Item(iI)
' Retrieve in the files collection only the Parts documents from its extension
If InStr(oFile.Name, ".CATP" ) <> 0 Then 'soll theoretisch Catparts wie auch Catproducts aufrufen
'und aufruf funktioniert auch, spätere Ansichterstellung nicht
' Set and open a Part document
Dim oDoc As Document
Set oDoc = CATIA.Documents.Open(oFile.Path)
'Set oDoc = CATIA.ActiveDocument
Dim product1 As Product
Set product1 = oDoc.Product
'User parameter filling & edit here
End If
' Create a drawing document: it becomes the active document.
Dim oDrawing As DrawingDocument
Set oDrawing = CATIA.Documents.Open("C:\Arbeitsverzeichnis\test_2d\Template_drw.CATDrawing")
' Retrieve the active sheet
Dim oSheet As DrawingSheet
Set oSheet = oDrawing.Sheets.ActiveSheet
' Create a view called "Front View" in this sheet
Dim oFrontView As DrawingView
Set oFrontView = oSheet.Views.Add("Front View")
' Retrieve it generative behavior
Dim oFrontViewGB As DrawingViewGenerativeBehavior
Set oFrontViewGB = oFrontView.GenerativeBehavior
' Declare the part to draw in this front view
'>>>>>>>>>>>>>>>>>>>>hier kommt zu Fehlermeldung<<<<<<<<<<<<<<<<<<<<
oFrontViewGB.Document = oDoc
' Define this view as a front view, with the XY plane (in oFile) as projection plane
oFrontViewGB.DefineFrontView 1, 0, 0, 0, 1, 0
' Position the View in the Sheet
oFrontView.x = 300
oFrontView.y = 150
' Update the view
oFrontViewGB.Update
'save as
'Dim generativDoc As Document
Dim oName As String
oName = oFrontView.GenerativeBehavior.Document.ReferenceProduct.Parent.Name
oName1 = Left(oName, InStrRev(oName, ".") - 1)
msgbox (sFolderPathOut & "\" & oName1 & ".CATDrawing")
'CATIA.ActiveDocument.SaveAs (sFolderPathOut & "\" & oName1 & "Zusatz1" & ".CATDrawing")
'CATIA.ActiveDocument.Close
'CATIA.ActiveDocument.Close
Next
End Sub
Foren auf CAD.de
| 
Sei Schlau bleib Dumm !!?!!
