Hallo Leute,
ich habe mal wieder eine Frage;-(
Ich habe die Ableitung von einem 3D Modell halbwegs programmiert.
Das Problem ist das ich mit "Opendocument" Catpart/product hochlade.
Wie mache ich am BESTEN wenn ich von einem aktiven Document/Product die Ableitung machen soll? und keinen Path geben soll?
ICH DANKE EUCH IM VORRAUS
MFG
BM der neue Einsteiger:-)
Sub CATMain()
Dim Eingabe As Long
Dim Boxx As Long
Boxx=InputBox ("Bitte wählen Sie 1=Rechteck oder 2=Radhalter","Auswahlfenster",Eingabe)
if Boxx=1 Then
Dim XX As String
XX=MsgBox ("Baustelle" & Chr(13) & Chr(10) &"",16,"Sorry")
Else
'Dim Box As String
'Box=MsgBox ("Ist die Nr: Korrekt" & Chr(13) & Chr (10) & Boxx &"" ,4, "Erkennung")
End if
if Boxx=2 Then
Dim XXX As String
XXX=MsgBox ("Welkommen " & Chr(13) & Chr(10) &"",16,"Erfolgreich")
'==================================================================
'if Boxx = "2" Then
' Dim Fehlermeldung As String
' Fehlermeldung = MsgBox ("Probieren Sie nochmal" & Chr(13) & Chr(10) &"",16,"Fehlermeldung")
'Else
'End if
'=========================================================
'Catia Document Öffnen:
'Dim ADoc As Document
'Set ADoc = CATIA.Documents.Add ("Part")
Dim documents1 As Documents
Set documents1 = CATIA.Documents
Dim partDocument1 As Document
Set partDocument1 = documents1.Open("C:\radhalter.CATPart")
'=======================================================
'Meldung zur 2 D Wechseln
Dim Wechselmeldung As String
Wechselmeldung = MsgBox ("2 D wird erzeugt" & Chr(13) & Chr(10) &"",16,"Zur Drafting")
'===============================================================
'Drawing Fenster Rufen:
Dim drawingDocument1 As Document
Set drawingDocument1 = documents1.Add("Drawing")
Dim drawingSheets1 As DrawingSheets
Set drawingSheets1 = drawingDocument1.Sheets
Dim drawingSheet1 As DrawingSheet
Set drawingSheet1 = drawingSheets1.Item("Sheet.1")
'======================================================================
' View 1
Dim drawingViews1 As DrawingViews
Set drawingViews1 = drawingSheet1.Views
Dim drawingView1 As DrawingView
Set drawingView1 = drawingViews1.Add("Kappe Front Ansicht")
drawingView1.x = -160
drawingView1.y = 0
drawingView1.Scale = 1.000000
Dim drawingViewGenerativeLinks1 As DrawingViewGenerativeLinks
Set drawingViewGenerativeLinks1 = drawingView1.GenerativeLinks
Dim drawingViewGenerativeBehavior1 As DrawingViewGenerativeBehavior
Set drawingViewGenerativeBehavior1 = drawingView1.GenerativeBehavior
'Hier erscheint immer fehler wenn ich mit dem
'Activedocument versuche !!!!Fehler Anzeige: product1 fehler usw
Dim product1 As CATBaseDispatch
Set product1 = partDocument1.GetItem("xxxxx")
drawingViewGenerativeBehavior1.Document = product1
'drawingViewGenerativeBehavior1.DefineFrontView 1.000000, 0.000000, 0.000000, 0.000000, 1.000000, 0.000000
'======================================================================
'View 2
Dim drawingViews2 As DrawingViews
Set drawingViews2 = drawingSheet1.Views
Dim drawingView2 As DrawingView
Set drawingView2 = drawingViews1.Add("Kappe Draufsicht")
drawingView2.x = 0
drawingView2.y = 0
drawingView2.Scale = 1.000000
Dim drawingViewGenerativeLinks2 As DrawingViewGenerativeLinks
Set drawingViewGenerativeLinks2 = drawingView2.GenerativeLinks
Dim drawingViewGenerativeBehavior2 As DrawingViewGenerativeBehavior
Set drawingViewGenerativeBehavior2 = drawingView2.GenerativeBehavior
drawingViewGenerativeBehavior2.Document = product1
Set drawingViewGenerativeBehavior1 = drawingView1.GenerativeBehavior
drawingViewGenerativeBehavior2.DefineProjectionView drawingViewGenerativeBehavior1, catTopView
'==========================================================================
'View 3
Dim drawingView3 As DrawingView
Set drawingView3 = drawingViews1.Add("3 View")
drawingView3.x = 120
drawingView3.y = 0
drawingView3.Scale = 1.000000
Dim drawingViewGenerativeLinks3 As DrawingViewGenerativeLinks
Set drawingViewGenerativeLinks3 = drawingView3.GenerativeLinks
Dim drawingViewGenerativeBehavior3 As DrawingViewGenerativeBehavior
Set drawingViewGenerativeBehavior3 = drawingView3.GenerativeBehavior
drawingViewGenerativeBehavior3.Document = product1
Set drawingViewGenerativeBehavior1 = drawingView1.GenerativeBehavior
drawingViewGenerativeBehavior3.DefineProjectionView drawingViewGenerativeBehavior1, catLeftView
Set drawingViewGenerativeBehavior1 = drawingView1.GenerativeBehavior
drawingViewGenerativeBehavior1.Update
Set drawingViewGenerativeBehavior2 = drawingView2.GenerativeBehavior
drawingViewGenerativeBehavior2.Update
Set drawingViewGenerativeBehavior3 = drawingView3.GenerativeBehavior
drawingViewGenerativeBehavior3.Update
'drawingView1.Activate
Else
End If
End Sub
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP