Tech-Ecke / CATScript/VBS Inhalt / Diverse Codeschnipsel

 

Diverse Codeschnipsel und Funktionen


 

Inhalt:  
  Aktives Dokument (Part/Product) innerhalb eines Products ermitteln
  Alle Dokumente des aktiven Products in ein Array schaufeln (über Selection Search)
  Copy & Paste eines Parts in ein neues Product
  Copy & Paste eines Parts in ein vorhandenes Product
  Copy & Paste des PartBody in ein neues Part - "as result"
  RootBodies ermitteln
  Modelltyp erkennen (Part, Product, V4, CGR...)
  Eltern eines Elements finden
  Prüfen ob ein Parameter vorhanden ist
   
  2D-View erzeugen
  Detailsheet ermitteln
  Unbenutze Details löschen - DelUnUsedDetails
  Projektionsrichtung ändern (First/Third Angle)

 

Aktives Dokument (Part/Product) innerhalb eines Products ermitteln

Mit diesem Schnipsel kann man das aktivierte (Blau hinterlegt / in Bearbeitung) Part bzw. Product ermitteln.

  Sub CATMain()

if TypeName(CATIA.ActiveDocument) = "ProductDocument" then
   set selection1 = CATIA.ActiveDocument.Selection
   selection1.Clear
   selection1.Search "(CATProductSearch.Product),in"
   if selection1.Count = 0 then
      ' wenn ein Part innerhalb des Products aktiv ist ---> Part im Product
      selection1.Search "(CATPrtSearch.PartFeature),in"
      set DokumentInst = GetDocumentByName(selection1.item(1).Value.Name)  ' Instanz
     
set Dokument = DokumentInst.ReferenceProduct.Parent ' Dokument
      selection1.Clear
   else
      ' wenn ein Product innerhalb des Products aktiv ist ---> Product im Product
      set DokumentInst = selection1.Item(1).Value ' Instanz
      set Dokument = DokumentInst.ReferenceProduct.Parent ' Dokument
      selection1.Clear
   end if
else
   ' wenn das aktive Dokument ein Part ist
   set Dokument = CATIA.ActiveDocument
end if

MsgBox TypeName(Dokument) &": " &Dokument.Name ' Ergebnis = das aktive Part bzw. Product

End Sub



Function GetDocumentByName(DokName)
On Error Resume Next

set Dokumente = CATIA.Documents
for n = 1 to Dokumente.count
   set Produkte = Dokumente.Item(n)
   WieOft = 0
   WieOft = Produkte.product.products.count
   for i = 1 to WieOft
      set Produkt = Produkte.product.products.item(i)
      if DokName = Produkt.PartNumber then
         set GetDocumentByName = Produkt
         Exit Function
      end if
   next
next
End Function
 

 

Alle Dokument-Instanzen des aktiven Products in ein Array schaufeln (über Selection Search)

  public DokAnzahl
public DokumentArray()

Sub CATMain()

Call GetElements(1)   ' 1 = Parts und Products

for n = 1 to DokAnzahl
   set Dokument = DokumentArray(n)
   MsgBox Dokument.Name ' gibt den Instanznamen aus
next

End Sub



Sub GetElements(SearchMode)

' Benötigt !!! Variable: public DokAnzahl: public DokumentArray()
' Eingabewerte: 1 = Parts und Products; 2 = nur Parts; 3 = nur Products


if SearchMode = 1 then SuchString = "Type=Product,all"
if SearchMode = 2 then SuchString = "(CATProductSearch.Part),all"
if SearchMode = 3 then SuchString = "(CATProductSearch.Assembly),all"

set Selection1 = CATIA.ActiveDocument.Selection
selection1.Search SuchString
DokAnzahl = selection1.Count

for n = 1 to DokAnzahl
   ReDim Preserve DokumentArray(n)
   set DokumentArray(n) = selection1.Item(n).Value
next

End Sub
 

 

Copy & Paste eines Parts in ein neues Product

Diese Funktion erzeugt ein neues Product und kopiert ein vorhandenes Part hinein.

  Sub CopyPartToNewProduct(PartDoc)
On Error Resume Next

' copy
set PartSelection = PartDoc.Selection
PartSelection.Clear
PartSelection.Add PartDoc.Part
PartSelection.Copy
' Product erstellen und benennen
set ProductDoc = CATIA.Documents.Add("Product")
set NeuesProduct = ProductDoc.Product.Products
n = 0: x = ""
do
   n = n +1
   Err.Number = 0:
   ProductName = "NewProduct" &x
   ProductDoc.Product.PartNumber = ProductName
   x = "_" &CStr(n)
loop until Err.Number = 0
' paste
set ProductSelection = ProductDoc.Selection
ProductSelection.Clear
ProductSelection.Add ProductDoc.Product
ProductSelection.Paste

End Sub
 

Aufruf: Es muss das Dokument zum Part angegeben werden.

  set PartDoc = CATIA.ActiveDocument   ' hier z.B. das aktive Part-Dokument
Call
CopyPartToNewProduct(PartDoc)

 

Copy & Paste eines Parts in ein vorhandenes Product

Mit dieser Funktion kann man ein vorhandenes Part in ein vorhandenes Product kopieren.

  Sub CopyPartToProduct(PartDoc, ProductDoc, TopProduct)

' copy
set PartSelection = PartDoc.Selection
PartSelection.Clear
PartSelection.Add PartDoc.Part
PartSelection.Copy
' paste
set ProductSelection = TopProduct.Selection
ProductSelection.Clear
ProductSelection.Add ProductDoc.Product
ProductSelection.Paste

End Sub
 

Aufruf: Es muss jeweils das Dokument zum Part und Product, sowie das TopProduct angegeben werden. Bei einstufigen Products ist das Product gleich dem TopProduct.

  Call CopyPartToProduct(PartDoc, ProductDoc, TopProduct)

 

Copy & Paste des PartBody in ein neues Part - "as result"

Ausgangspunkt ist ein Produkt mit mindestens einem Part. Zunächst wird ein neues Product geöffnet. Über dieses Product wird der PartBody des betreffenden Quell-Parts kopiert. Dann wird ein neues Part geöffnet und der kopierte PartBody als "Result As" eingefügt. Anschließend wird das temporäre Product wieder gelöscht 

  Sub CATMain()

set QuellPart = CATIA.ActiveDocument.Product.Products.Item(1)

FensterNr = Catia.Windows.Count +1

set NeuesDokument = CATIA.Documents.Add("Product")

set TempSelection = CATIA.ActiveDocument.Selection
TempSelection.Add(QuellPart.ReferenceProduct.Parent.Part.MainBody)
TempSelection.copy
TempSelection.Clear

set NeuesPart = CATIA.Documents.Add("Part")
set PasteSelection = NeuesPart.Selection
PasteSelection.clear
PasteSelection.Add NeuesPart.Part
PasteSelection.PasteSpecial "CATPrtResultWithOutLink"
PasteSelection.Clear


CATIA.Windows.Item(FensterNr).Activate
CATIA.ActiveDocument.Close

End Sub
 

 

Root-Bodies ermitteln

Mit diesem Schnipsel kann man die Root-Bodies eines Parts ermitteln. Mit Root-Bodies sind Bodies gemeint, die nicht über eine Boolesche Operation einem anderen Body zugeordnet sind und somit in der Root des Strukturbaums stehen.

  Sub CATMain()

set Bodies1 = CATIA.ActiveDocument.Part.Bodies

for n = 1 to CATIA.ActiveDocument.Part.Bodies.count
   set Body1 = Bodies1.Item(n)

   if Body1.InBooleanOperation = false then
      MsgBox Body1.Name
   end if
next

End Sub
 

 

  Modelltyp erkennen (Part, Product, V4, CGR...)

Mitunter kann es erforderlich bzw. nützlich sein zu wissen, welcher Dateityp hinter einer Produktinstanz steht. Die Unterscheidung zwischen Parts und Products ist auch mittels TypeName(Dokument) möglich, jedoch werden V4 Modelle oder CGR-Daten mit dieser Methode auch aus Products erkannt. Hier ein Weg der zumindest noch zusätzlich V4 Modelle und andere Daten erkennen lässt, wobei weitere Daten beim Einlesen in CGR, also triangulierte Flächenmodell gewandelt werden und somit beispielsweise auch ein IGES-File als CGR erkannt wird.

  Sub CATMain()
On Error Resume Next

set selection1 = CATIA.ActiveDocument.Selection
selection1.Search "(CATProductSearch.Product),all"

for i = 1 to selection1.Count
   Endung = ""
   set Bauteil = selection1.Item(i).Value
   Endung = StrReverse(Bauteil.GetMasterShapeRepresentationPathName)
   if Endung = "" then Endung = StrReverse(Bauteil.ReferenceProduct.Parent.Name)
   EndungArray = split(Endung,".")
   Endung = StrReverse(EndungArray(0))
   if Endung = "" then
      DatenFormat = "Dateilink gebrochen"
   elseif UCase(Endung) = "CATPART" then
      DatenFormat = "V5-Part"
   elseif UCase(Endung) = "CATPRODUCT" then
      DatenFormat = "V5-Product"
   elseif UCase(Endung) = "MODEL" then
      DatenFormat = "V4-Modell"
   else
      DatenFormat = "Trianguliertes Flächenmodell"
   end if
   MsgBox DatenFormat
next

End Sub
 

 

Prüfen ob ein Parameter vorhanden ist

  Function ParameterExists(oParamSet, sParam)
   ' anstelle vom ParameterSet kann auch Part/Product.Parameters angegeben werden
   ' wenn die Parameter nicht in einem Set zusammengefasst sind

   On Error Resume Next
   ParameterExists = false
   s = ""
   s = oParamSet.Item(sParam).Name
   if s <> "" then ParameterExists = true
End Function
 

Aufruf: Im Beispiel wird geprüft ob ein Parameter mit dem Namen "MeinParameter" vorhanden ist, wenn nicht, dann wird dieser erzeugt.

  set oParameters = CATIA.ActiveDocument.Part.Parameters
if ParameterExists(oParameters, "MeinParameter") then
   set oParam = oParameters.Item("MeinParameter")
else
   set oParam = oParameters.CreateString("MeinParameter", "")
end if

 

Eltern eines Elements finden

  Function FindParent(Element, ParentTyp)
 set Puffer = Element
 fertig = false
 do
    if TypeName(Puffer) = ParentTyp then
       set FindParent = Puffer
       fertig = true
    elseif TypeName(Puffer) = "CNEXT" then
       fertig = true
    end if
 set Puffer = Puffer.Parent
 loop until fertig = true
End Function
 

Aufruf: Es muss ein Element (Objekt) und der zu suchende Eltern-Typ als String übergeben werden. Der Rückgabewert ist das gesuchte Elternteil als Objekt.

   MsgBox FindParent(Element, "Part").Name

 

2D-View erzeugen

Dieser Schnipsel erzeugt eine neue 2D-View auf dem aktuellen Sheet.

 

Sub CATMain()

set ActSheet = CATIA.ActiveDocument.Sheets.ActiveSheet
set NewSheet = ActSheet.Views.Add("NewView")
set drawingViewGenerativeBehavior1 = NewSheet.GenerativeBehavior
drawingViewGenerativeBehavior1.DefineFrontView 1.000000, 0.000000, 0.000000, 0.000000, 1.000000, 0.000000
NewSheet.x = 0
NewSheet.y = 0
NewSheet.Scale = 1.000000
NewSheet.Activate

End Sub

 
 

 

Detail-Sheet ermitteln

Dieser Codeschnipsel prüft ob das aktive Sheet ein Detail-Sheet ist oder nicht. Im Falle eines Detail-Sheets wird die Ausgabe "true" bzw. "wahr" sein.

 

Sub CATMain()

set DrawDoc = CATIA.ActiveDocument
set ActSheet = DrawDoc.Sheets.ActiveSheet
MsgBox ActSheet.IsDetail

End Sub

 

 

Unbenutze Details löschen - DelUnUsedDetails

Dieser Codeschnipsel löscht alle nicht genutzten Details. Es werden alle Detailssheets berücksichtigt.

 

Sub DelUnUsedDetails()

DitoNr = 0
for i = 1 to CATIA.ActiveDocument.Sheets.Count
   set oSheet = CATIA.ActiveDocument.Sheets.Item(i)
   if not oSheet.IsDetail then
      for j = 1 to oSheet.Views.Count
         set oView = oSheet.Views.Item(j)
         for k = 1 to oView.Components.Count
            set oDetail = oView.Components.Item(k)
            DitNameNr = DitNameNr +1
            ReDim Preserve DitName(DitNameNr)
            DitName(DitNameNr) = oDetail.CompRef.Name
         next
      next
   else

      for n = 1 to oSheet.Views.Count -2
         set oView = oSheet.Views.Item(n +2)
         DitNr = DitNr +1
         ReDim Preserve Dit(DitNr)
         set Dit(DitNr) = oView
      next
   end if
next

set Sel = CATIA.ActiveDocument.Selection
Sel.Clear
for i = 1 to DitNr
   dName = Dit(i).Name
   InUse = 0
   ' Ausnahmen
   if InStr(1,dName,"Test") > 0 then InUse = 1
   ' ---------
   for j = 1 to DitNameNr
      if dName = DitName(j) then InUse = 1
   next
   if InUse = 0 then Sel.Add(Dit(i))
next

Sel.Delete

end sub

 

Anwendung:

  Call DelUnUsedDetails

 

Projektionsrichtung (First/Third Angle)

Dieser Codeschnipsel erlaubt es zwischen den Projektionsrichtungen, englischer Klappung (third angle) und europäischer Klappung (first angle) zu wechseln.

 

Sub AngleSwitch(Angle)

' 0 = catFirstAngle; 1 = catThirdAngle
for n = 1 to CATIA.ActiveDocument.Sheets.Count
   set oSheet = CATIA.ActiveDocument.Sheets.Item(n)
   oSheet.ProjectionMethod = Angle
next

end Sub

 

Anwendung:

   AngleSwitch(0) ' europäische Klappung
 AngleSwitch(1) ' englische Klappung

"Die Option Drucken funktioniert erst ab Netscape V4.0 bzw. I-Explorer 5.0 !"

[letzte Aktualisierung 04.04.2017]