Vítejte !   Přihlášení | Registrace
Hlavní menu
CATIA fórum.cz
Novinky
Seriál CATIA
Obecně o CAD
Novinky ze světa DS
Makra pro CATIA V5
Diskuse
Vytvořit téma
Koncepty
Seznam oblíbených
Soukromé zprávy
Pravidla
Live CHAT
VIP žádost
Základy Catia
Ke stažení
Doporučujeme
Pracovní příležitosti
Reklama a kampaně
O fóru
Nápověda

PartNumber - jméno partu na disku

UživatelPříspěvek
Dana Janovská

Poslat zprávu | Profil
Datum: 23.8. 2012 | Zobrazeno: 15486x
Konfigurace CATIA:

Text dotazu:
Dobrý den,
hledám makro pro kontrolu A opravu eventuálního rozdílu mezi názvem stromu a jménem partu na disku. - (Nemáme zde žádnou Enovii ani SMartTeam...)
Při Send To, sice mohu přejmenovat part na disku, ale jméno stromu zůstane stejné.

Má Catia sama o sobě nějakou funkci, která to umí, nebo lze toto naprogramovat nějakým záznamem makra? (jinak makro zatím neumím) Nebo, poradíte mi někdo na zdroj free makra? Nebo ... třeba přiměju zaměstnavatele ke koupi, ale to mu musím alespoň naznačit, co to bude stát.... Máte někdo představu?

agaragar

Poslat zprávu | Profil
[#3233] | Publikováno: 23.08. 2012 - 21:38
Dobrý deň,

Skuste si toto makro:
Premenuje to súbor podľa PartNumber


Dim answer

'-------------------------------------------
Sub CATMain()
Dim acDoc
Dim acProd
Set acDoc = CATIA.ActiveDocument
Set acProd = acDoc.Product

acProd.ApplyWorkMode DESIGN_MODE

answer = MSGBOX("Do you wish to delete the original file?",36,"DELETION")

WalkThroughTree acProd
CATIA.DisplayFileAlerts = true
END_MESSAGE
End SUB
'-------------------------------------

'-------------------------------------
Sub WalkThroughTree(oParent)
Dim iProduct
Dim oChild

For iProduct = 1 TO oParent.Products.Count
Set oChild = oParent.Products.Item(iProduct)
If oChild.Parameters.Count <> 0 THEN
If oChild.Parameters.Item(oChild.Parameters.Count).ValueAsString = "true" THEN
'--------------------
'ADDS PARTNUMBER AND OLD INSTANCE NUMBER As NEW INSTANCENAME
tmp = SPLIT(oChild.Name,".")
oChild.Name = oChild.PartNumber & "." & tmp(UBOUND(tmp))
'--------------------
'SENDS CHILDREN WITH NO CHILDREN TO SAVE AND CHILDREN WITH CHILDERN TO WALTHROUGH (BOTTOM UP)
If oChild.Products.Count = 0 THEN
SaveAsPartNumber oChild.ReferenceProduct
ELSE
WalkThroughTree oChild.ReferenceProduct
End IF
End IF
End IF
NEXT
'--------------------
'SENDS THE PRODUCT TO SAVE AFTER ALL CHILDREN HAVE BEEN SAVED
If oChild.Parameters.Item(oChild.Parameters.Count).ValueAsString = "true" THEN
If oParent.Products.Count > 0 THEN
SaveAsPartNumber oParent
End IF
End IF
End SUB
'-------------------------------------

'-------------------------------------
Sub SaveAsPartNumber (oProd)
Dim objToDelete
Dim orginalPath
Dim oDoc
CATIA.DisplayFileAlerts = false
For Each oDoc IN CATIA.Documents
If TYPENAME(oDoc) = "ProductDocument" OR TYPENAME(oDoc) = "PartDocument" THEN
If oDoc.Product.PartNumber = oProd.PartNumber THEN
objToDelete = oDoc.FullName
orginalPath = oDoc.Path & "\"
If oProd.HasAMasterShapeRepresentation Then 'A PART HAs A MASTERSHAPEREPREASENTATION
If CATIA.FileSystem.FileExists(orginalPath & oProd.PartNumber & ".CATPart") = False THEN
oDoc.SaveAs(orginalPath & oProd.PartNumber & ".CATPart")
If answer = 6 Then CATIA.FileSystem.DeleteFile(objToDelete)
End IF
ELSE
If CATIA.FileSystem.FileExists(orginalPath & oProd.PartNumber & ".CATProduct") = False THEN
oDoc.SaveAs(orginalPath & oProd.PartNumber & ".CATProduct")
If answer = 6 Then CATIA.FileSystem.DeleteFile(objToDelete)
End IF
End IF
End IF
End IF
NEXT
End SUB
'-------------------------------------
'----------------------------------------
Sub END_MESSAGE()
MSGBOX "MACRO_NAME"
End SUB
Dana Janovská

Poslat zprávu | Profil
[#3236] | Publikováno: 24.08. 2012 - 07:40
To agaragar ... děkuji, otestuji .
Častěji potřebuji přejmenovávat PartNumber dle FileName. Ale i toto je velmi častý otravný úkol.
agaragar

Poslat zprávu | Profil
[#3237] | Publikováno: 24.08. 2012 - 11:26
Dobrý deň,

No keď som sa už tak rozbehol, tak prikladám Vám aj tú opačnú možnosť premenovania.


Sub CATMain()
Dim acDoc
Dim acProd
Dim tmpString
Dim FileName
Dim FileSeparator
FileSeparator = CATIA.FileSystem. FileSeparator

Set acDoc = CATIA.ActiveDocument
Set acProd = acDoc.Product

acProd.ApplyWorkMode DESIGN_MODE

'SETS THE PartNumber = FileName For ALL DOCUMENTS OPEN IN CATIA.
'WILL CRASH If DRWAING ECT ARE OPEN!
For Each oDoc IN CATIA.Documents
tmp = SPLIT(oDoc.FullName, FileSeparator)
tmpString = tmp(UBOUND(tmp))
tmp = SPLIT(tmpString,".")
FileName = tmp(0)
oDoc.Product.PartNumber = FileName
NEXT
InstanceName acProd
WalkThroughTree acProd
END_MESSAGE
End SUB
'-------------------------------------

'-------------------------------------
Sub WalkThroughTree(oParent)
Dim iProduct
Dim oChild
For iProduct = 1 TO oParent.Products.Count
Set oChild = oParent.Products.Item(iProduct)
InstanceName oChild.ReferenceProduct
WalkThroughTree oChild.ReferenceProduct
NEXT
End SUB
'-------------------------------------

'-------------------------------------
Sub InstanceName (oParent)
Set oDict = CreateObject("Scripting.Dictionary")
ON ERROR RESUME NEXT
Dim iProduct
Dim oItemToRename
Dim ItemPartNumber
For Each oItemToRename IN oParent.Products
ItemPartNumber = oItemToRename.PartNumber
If oDict.Exists(ItemPartNumber) Then
oDict.Item(ItemPartNumber) =oDict.Item(ItemPartNumber) +1
Else
oDict.Add ItemPartNumber, 1
End If
'rename Parts
oItemToRename.Name = ItemPartNumber & "--tmpStringToStopERRORS" & oDict.Item(ItemPartNumber)
NEXT
oDict.RemoveAll

For Each oItemToRename IN oParent.Products
ItemPartNumber = oItemToRename.PartNumber
If oDict.Exists(ItemPartNumber) Then
oDict.Item(ItemPartNumber) =oDict.Item(ItemPartNumber) +1
Else
oDict.Add ItemPartNumber, 1
End If
'rename Parts
oItemToRename.Name = ItemPartNumber & "." & oDict.Item(ItemPartNumber)
NEXT
oDict.RemoveAll
End SUB
'-------------------------------------

'----------------------------------------
Sub END_MESSAGE()
MSGBOX "OK"
End SUB
agaragar

Poslat zprávu | Profil
[#3238] | Publikováno: 24.08. 2012 - 11:39
PS: hlavne si vždy pred spúšťaním hociakého makra všetko zálohujte.
Ing Jan Cinert

Poslat zprávu | Profil
[#3239] | Publikováno: 24.08. 2012 - 13:28
To není úplně dobré doporučení s tím zálohováním. Není lepší to makro ošetřit? :-)
agaragar

Poslat zprávu | Profil
[#3240] | Publikováno: 24.08. 2012 - 13:54
Ja nevravím, že to makro je zlé, iba opatrnosti nikdy nie je dosť pri dôležitej práci.

+ programátorská fráza:
"ak všetko pracuje správne, tak s najväčšou
pravdepodobnosťou programátor urobil niekde chybu!"

:o)

A Vám pani Dana, pomohlo makro?
Břeťa Doležal

Poslat zprávu | Profil
[#3241] | Publikováno: 24.08. 2012 - 13:59
Makro na změnu PartNumber dle jména souboru. Vytvořeno ve VB2010 (exe soubor)

Přiložené soubory:
filenametopartnumber.zip

Dana Janovská

Poslat zprávu | Profil
[#3244] | Publikováno: 24.08. 2012 - 14:28
Pro agaragar
Partdon prodlevu. měla jsem tu shon.

Makro pro přejmenování PartNumber dle FIlename se mi zarazí na řádce 76 sloupec 12 - MSGBOX "OK"... Zatím nejsem dost sběhlá, abych identifikovala, co se u nelíbí. (ale učím se)

Opačné se zarazí ma lince 89 slopec 0 (po dotazu zda smazat ten původní part.)

Ani v jednom případě nepřejmenuje a ani nevymaže nic.


Pro Břeťu ... jdu ozkoušet :-) děkuji.

agaragar

Poslat zprávu | Profil
[#3245] | Publikováno: 24.08. 2012 - 14:33
Ak to zastane pri MSGBOXu, tak som to vymazal a skúste teraz
MSGBOX je iba oznam, ten tam nemusí byť.


Sub CATMain()
Dim acDoc
Dim acProd
Dim tmpString
Dim FileName
Dim FileSeparator
FileSeparator = CATIA.FileSystem. FileSeparator

Set acDoc = CATIA.ActiveDocument
Set acProd = acDoc.Product

acProd.ApplyWorkMode DESIGN_MODE

'SETS THE PartNumber = FileName For ALL DOCUMENTS OPEN IN CATIA.
'WILL CRASH If DRWAING ECT ARE OPEN!
For Each oDoc IN CATIA.Documents
tmp = SPLIT(oDoc.FullName, FileSeparator)
tmpString = tmp(UBOUND(tmp))
tmp = SPLIT(tmpString,".")
FileName = tmp(0)
oDoc.Product.PartNumber = FileName
NEXT
InstanceName acProd
WalkThroughTree acProd

End SUB
'-------------------------------------

'-------------------------------------
Sub WalkThroughTree(oParent)
Dim iProduct
Dim oChild
For iProduct = 1 TO oParent.Products.Count
Set oChild = oParent.Products.Item(iProduct)
InstanceName oChild.ReferenceProduct
WalkThroughTree oChild.ReferenceProduct
NEXT
End SUB
'-------------------------------------

'-------------------------------------
Sub InstanceName (oParent)
Set oDict = CreateObject("Scripting.Dictionary")
ON ERROR RESUME NEXT
Dim iProduct
Dim oItemToRename
Dim ItemPartNumber
For Each oItemToRename IN oParent.Products
ItemPartNumber = oItemToRename.PartNumber
If oDict.Exists(ItemPartNumber) Then
oDict.Item(ItemPartNumber) =oDict.Item(ItemPartNumber) +1
Else
oDict.Add ItemPartNumber, 1
End If
'rename Parts
oItemToRename.Name = ItemPartNumber & "--tmpStringToStopERRORS" & oDict.Item(ItemPartNumber)
NEXT
oDict.RemoveAll

For Each oItemToRename IN oParent.Products
ItemPartNumber = oItemToRename.PartNumber
If oDict.Exists(ItemPartNumber) Then
oDict.Item(ItemPartNumber) =oDict.Item(ItemPartNumber) +1
Else
oDict.Add ItemPartNumber, 1
End If
'rename Parts
oItemToRename.Name = ItemPartNumber & "." & oDict.Item(ItemPartNumber)
NEXT
oDict.RemoveAll
End SUB
Dana Janovská

Poslat zprávu | Profil
[#3246] | Publikováno: 24.08. 2012 - 14:38
Pro Břeťa Doležal
Načte ParNumber i FileName ze sestavy. FileName zobrazí včetně cesty.
Ale vyhodí chybovou hlášku a dále nepracuje.
Předpokládám, že se má rozrolovat obsah sestavy - až do pátého levelu až k dílům
a po kliknutí na FileName - ParTnumber (tlačítko není púo chybové hlášce aktivní) má provést úpravu.
Obsah chybové hlášky přikládám.
a DĚKUJIII



See the End of this message For details on invoking
just-in-time (JIT) debugging instead of this dialog box.

************** Exception Text **************
System.Runtime.InteropServices.COMException (0x80004005): Error HRESULT E_FAIL hAs been returned from a call to a COM component.
at ProductStructureTypeLib.Product.get_ReferenceProduct()
at WindowsApplication1.frmOutputTable.btnStart_Click(Object sender, EventArgs e)
at System.Windows.Forms.Control.OnClick(EventArgs e)
at System.Windows.Forms.Button.OnClick(EventArgs e)
at System.Windows.Forms.Button.OnMouseUp(MouseEventArgs mevent)
at System.Windows.Forms.Control.WmMouseUp(Message& m, MouseButtons button, Int32 clicks)
at System.Windows.Forms.Control.WndProc(Message& m)
at System.Windows.Forms.ButtonBase.WndProc(Message& m)
at System.Windows.Forms.Button.WndProc(Message& m)
at System.Windows.Forms.Control.ControlNativeWindow.OnMessage(Message& m)
at System.Windows.Forms.Control.ControlNativeWindow.WndProc(Message& m)
at System.Windows.Forms.NativeWindow.Callback(IntPtr hWnd, Int32 msg, IntPtr wparam, IntPtr lparam)


************** Loaded Assemblies **************
mscorlib
Assembly Version: 2.0.0.0
Win32 Version: 2.0.50727.5448 (Win7SP1GDR.050727-5400)
CodeBase: file:///C:/Windows/Microsoft.NET/Framework/v2.0.50727/mscorlib.dll
----------------------------------------
PartNumber_FileName
Assembly Version: 1.0.0.0
Win32 Version: 1.0.0.0
CodeBase: file:///D:/___WORK___/PartNumber%20-%20FIlename/PartNumber_FileName.exe
----------------------------------------
Microsoft.VisualBasic
Assembly Version: 8.0.0.0
Win32 Version: 8.0.50727.5420 (Win7SP1.050727-5400)
CodeBase: file:///C:/Windows/assembly/GAC_MSIL/Microsoft.VisualBasic/8.0.0.0__b03f5f7f11d50a3a/Microsoft.VisualBasic.dll
----------------------------------------
System
Assembly Version: 2.0.0.0
Win32 Version: 2.0.50727.5453 (Win7SP1GDR.050727-5400)
CodeBase: file:///C:/Windows/assembly/GAC_MSIL/System/2.0.0.0__b77a5c561934e089/System.dll
----------------------------------------
System.Windows.Forms
Assembly Version: 2.0.0.0
Win32 Version: 2.0.50727.5446 (Win7SP1GDR.050727-5400)
CodeBase: file:///C:/Windows/assembly/GAC_MSIL/System.Windows.Forms/2.0.0.0__b77a5c561934e089/System.Windows.Forms.dll
----------------------------------------
System.Drawing
Assembly Version: 2.0.0.0
Win32 Version: 2.0.50727.5458 (Win7SP1GDR.050727-5400)
CodeBase: file:///C:/Windows/assembly/GAC_MSIL/System.Drawing/2.0.0.0__b03f5f7f11d50a3a/System.Drawing.dll
----------------------------------------
System.Runtime.Remoting
Assembly Version: 2.0.0.0
Win32 Version: 2.0.50727.5420 (Win7SP1.050727-5400)
CodeBase: file:///C:/Windows/assembly/GAC_MSIL/System.Runtime.Remoting/2.0.0.0__b77a5c561934e089/System.Runtime.Remoting.dll
----------------------------------------
System.Configuration
Assembly Version: 2.0.0.0
Win32 Version: 2.0.50727.5420 (Win7SP1.050727-5400)
CodeBase: file:///C:/Windows/assembly/GAC_MSIL/System.Configuration/2.0.0.0__b03f5f7f11d50a3a/System.Configuration.dll
----------------------------------------
System.Xml
Assembly Version: 2.0.0.0
Win32 Version: 2.0.50727.5420 (Win7SP1.050727-5400)
CodeBase: file:///C:/Windows/assembly/GAC_MSIL/System.Xml/2.0.0.0__b77a5c561934e089/System.Xml.dll
----------------------------------------
Interop.ProductStructureTypeLib
Assembly Version: 0.0.0.0
Win32 Version: 0.0.0.0
CodeBase: file:///D:/___WORK___/PartNumber%20-%20FIlename/Interop.ProductStructureTypeLib.DLL
----------------------------------------
Interop.INFITF
Assembly Version: 0.0.0.0
Win32 Version: 0.0.0.0
CodeBase: file:///D:/___WORK___/PartNumber%20-%20FIlename/Interop.INFITF.DLL
----------------------------------------
System.Core
Assembly Version: 3.5.0.0
Win32 Version: 3.5.30729.5420 built by: Win7SP1
CodeBase: file:///C:/Windows/assembly/GAC_MSIL/System.Core/3.5.0.0__b77a5c561934e089/System.Core.dll
----------------------------------------
CustomMarshalers
Assembly Version: 2.0.0.0
Win32 Version: 2.0.50727.5420 (Win7SP1.050727-5400)
CodeBase: file:///C:/Windows/assembly/GAC_32/CustomMarshalers/2.0.0.0__b03f5f7f11d50a3a/CustomMarshalers.dll
----------------------------------------

************** JIT Debugging **************
To enable just-in-time (JIT) debugging, the .config file For this
application or computer (machine.config) must have the
jitDebugging value Set in the system.windows.forms section.
The application must also be compiled with debugging
enabled.

For example:

<configuration>
<system.windows.forms jitDebugging="true" />
</configuration>

When JIT debugging is enabled, any unhandled exception
will be sent to the JIT debugger registered on the computer
rather than be handled by this dialog box.




Dana Janovská

Poslat zprávu | Profil
[#3247] | Publikováno: 24.08. 2012 - 14:50
Uživatel cituje z příspěvku #3245:
'Ak to zastane pri MSGBOXu, tak som to vymazal a skúste teraz
MSGBOX je iba oznam, ten tam nemusí byť. '


Teď .. u větší sestavy chvilku chroustá, pak se zarazí na line 41 column 0
(Runtime error
Description: Object doesn't support this property or method:
'oDoc.Product'
Line: 41
Column: 0
agaragar

Poslat zprávu | Profil
[#3248] | Publikováno: 24.08. 2012 - 15:02
Musí tam byť dodržaná podmienka:

'SETS THE PartNumber = FileName For ALL DOCUMENTS OPEN IN CATIA.
'WILL CRASH If DRWAING ECT ARE OPEN!

Nesmiete mať otvorené v Catii nič iné iba jednu zostavu a na ňu to aplikovať,
skúste zavrieť CATIU, a potom otvoriť iba jednu zostavu CATProduct, či spraví tú istú chybu.
Dana Janovská

Poslat zprávu | Profil
[#3249] | Publikováno: 24.08. 2012 - 15:12
Uživatel cituje z příspěvku #3248:
'Musí tam byť dodržaná podmienka:

'SETS THE PartNumber = FileName For ALL DOCUMENTS OPEN IN CATIA.
'WILL CRASH If DRWAING ECT ARE OPEN! '


Vytvořila jsem novou sestavu je se třemi díly, každý jen v jedné instanci.
Te´d se zarazil na line 45
prohlásil., že type mismatch: 'END_MESSAGE'

Na velké sestavě - čerstvě otevřené po restartu Catie s několika sty díly. Mnoho z nich v mnoha isntancích... právě ta line 41.

agaragar ... děkuji za pomoc ... odjíždím do středy nebudu u netu ani u Catie. Hned pak se vrátím ke zkoumání.
agaragar

Poslat zprávu | Profil
[#3250] | Publikováno: 24.08. 2012 - 15:17
Ahá jasné zabudol som vymazať ten END_Message, vymažte ho a pôjde to.
Upravím to aj hore, kde som to vkladal upravené.
agaragar

Poslat zprávu | Profil
[#3251] | Publikováno: 24.08. 2012 - 15:26
Ak nechcete meniť názov Instancii v (part.1) potom stačí aj toto:


Sub CATMain()
Dim acDoc
Dim acProd
Dim tmpString
Dim FileName
Dim FileSeparator

FileSeparator = CATIA.FileSystem. FileSeparator

Set acDoc = CATIA.ActiveDocument
Set acProd = acDoc.Product
acProd.ApplyWorkMode DESIGN_MODE

'SETS THE PartNumber = FileName For ALL DOCUMENTS OPEN IN CATIA.
'WILL CRASH If DRWAING ECT ARE OPEN!

For Each oDoc IN CATIA.Documents
tmp = SPLIT(oDoc.FullName, FileSeparator)
tmpString = tmp(UBOUND(tmp))
tmp = SPLIT(tmpString,".")
FileName = tmp(0)
oDoc.Product.PartNumber = FileName

NEXT

End SUB
Břeťa Doležal

Poslat zprávu | Profil
[#3264] | Publikováno: 27.08. 2012 - 08:57
Uživatel odpovídá na příspěvek #3246:


Ufff, tak to netuším, kde je chybička. Vypadá to, že částečně makro beželo a na něčem zkolabovalo. Nemám ošetřeno vše univerzálně. Možná používáte v sestavách něco co my ne. Jinak dokáže makro jít do jakéhokoliv levelu.

Je možné udělat třeba nějakou jednoduchou sestavu zkusit na ní makro a pokud to stále kolabuje, tak poskytnout tuto sestavu?

Klidně poskytnu i zdroj, ale je potom zapotřebí mít Visual Studio a potom si to zkompilovat.

A nebo rovnou, zde je zdroj: (na formuláři jsou tři tlačítka btnStart, btnVycistit, btnChangePN a DataGridView). Třebas někdo uvidí chybičku, která se u mě neprojeví.


Public Class frmOutputTable
Public Const strCaption As String = "Makro - Partname & FileName"
Public CATIA As INFITF.Application 'CATIA Application Object

Dim msgText As String
Dim msgResp As MsgBoxResult
Dim msgButtons As MsgBoxStyle
Dim colAssyLevel As New Collections.Generic.List(Of Integer)
Dim colPodprodukty As New Collections.Generic.List(Of Product)
Dim objProdukt As Product
Dim intMaxAssyLevel As Integer


Public Function JeKonec(ByVal istrMessage As String) As Boolean
'Vrátí True nebo False podle reakce uživatele

CATIA.StatusBar = istrMessage
istrMessage &= vbCrLf & "Chceš teď předčasně ukončit makro"
msgButtons = MsgBoxStyle.Question Or MsgBoxStyle.YesNo
msgResp = MsgBox(istrMessage, msgButtons, strCaption)
If msgResp = vbYes Then
Return (True)
Else
Return (False)
End If
CATIA.StatusBar = ""
End Function 'JeKonec

Public Function GetProdukt(ByVal iCATIA As INFITF.Application) As Product
'Vrátí objekt Product z aktivního dokumentu, případně otevře nový dokument.
'V případě, že není aktivní Product a makro bude přerušeno, Funkce vrátí Nothing
Dim Soubor As String
Dim objDocument As Document
Dim blnSestavaOtevrena As Boolean = False

Do
Try
objDocument = iCATIA.ActiveDocument 'Přiřazení aktivního dokumentu
If TypeName(objDocument) = "ProductDocument" Then 'Pokud je aktivním dokumentem setava tak ji předá a ukončí tuto funkci
Return (CType(objDocument.Product, Product))
Else
msgText = TypeName(objDocument) & " nemůže být použit pro toto makro" & vbCrLf 'Sice je něco v Catii, ale není to sestava "
msgText &= "
Sestava (CATProduct) musí být načtená a aktivní pro toto makro!"
If JeKonec(msgText) Then 'Chceš skončit tuto funkci
Return (Nothing) ' ANO konec funkce, vrací nothing
End If
End If

Catch ex As Exception
msgText = "
Sestava (CATProduct) musí být načtená a aktivní pro toto makro!"
If JeKonec(msgText) Then 'Chceš skončit tuto funkci
Return (Nothing) ' ANO konec funkce, vrací nothing
End If
End Try

'NE neukončí funkci a dále nabídne otevření sestavy
Do
msgText = "
Otevři sestavu (CATProduct), kterou chceš analyzovat"
iCATIA.StatusBar = msgText
Soubor = iCATIA.FileSelectionBox("
Oteřít CATProduct", "*.CATProduct", CatFileSelectionMode.CatFileSelectionModeOpen)

If String.IsNullOrEmpty(Soubor) Or Not (Soubor.Contains("
CATProduct")) Then
msgText = "
Otevřen špatný soubor. Musí být otevřen CATProduct!"
If JeKonec(msgText) Then 'Chceš skončit tuto funkci
Return (Nothing) ' ANO konec funkce, vrací nothing
End If
Else
Try
iCATIA.Documents.Open(Soubor)
blnSestavaOtevrena = True 'pokud se podaří otevřít dokument smyčka pro otvírání souboru bude ukončena
Catch ex As Exception
msgText = "
Sestavu nelze otevřít!"
If JeKonec(msgText) Then 'Chceš skončit tuto funkci
Return (Nothing) ' ANO konec funkce, vrací nothing
End If
End Try
End If
'NE tak znovu otevírej sestavu, smyčka

Loop Until blnSestavaOtevrena
Loop
End Function 'GetProdukt

''' summary
''' Rekurzivní funkce pro procházení sestavy
''' summary
''' param name=iProduktDefinuje Product který se má projítparam
''' param name=iAssyLevelAktuální úroveň Productu v sestavěparam
''' param name=iPodproduktyKolekce vyzískaných Produktuparam
''' remarks
''' Prozkoumá sestavu iProdukt Do hloubky a případné nalezené produkty přidá Do iPodprodukty
''' remarks
Public Sub ProduktExplorer(ByVal iProdukt As Product, ByVal iAssyLevel As Integer, ByVal iPodprodukty As Collections.Generic.List(Of Product))
Dim locProdukty As Products 'Kolekce produktů uvnitř produktu iProdukt
Dim locProdukt As Product 'Produkt z kolekce Produkty
Dim intAssyLevel As Integer = iAssyLevel

intAssyLevel += 1
locProdukty = iProdukt.Products
For Each locProdukt In locProdukty
iPodprodukty.Add(locProdukt)
colAssyLevel.Add(intAssyLevel)
ProduktExplorer(locProdukt, intAssyLevel, iPodprodukty) 'Rekurzivní volání
Next locProdukt
intAssyLevel -= 1
End Sub 'ProduktExplorer

''' summary
''' Určení nejnižší úrovně sestavy
''' summary
''' param name=iAssyLevelsKolekce iAssyLevels, ze kterých se má určit maximumparam
''' returnsMaximální level - nejnižší úroveň sestavyreturns
''' remarks
''' Projde kolekci a vyhledá nejvyšší vnoření v sestavě
''' remarks
Public Function GetMaxLevel(ByVal iAssyLevels As System.Collections.Generic.List(Of Integer)) As Integer
'Vrátí maximální level v seznamu subkomponent
Dim locMaxLevel As Integer = 0

For i As Integer = 0 To iAssyLevels.Count - 1
If iAssyLevels.Item(i) > locMaxLevel Then locMaxLevel = iAssyLevels.Item(i)
Next i
Return locMaxLevel
End Function 'GetMaxLevel

Private Sub btnStart_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnStart.Click
Dim locDocument As Document
Dim locProdukt As Product
Dim intLevel As Integer


Cursor.Current = Cursors.WaitCursor
CleanGrid()

'vytvoření objektu CATIA
Try
CATIA = CType(GetObject(, "
CATIA.Application"), INFITF.Application)
Exit Try
Catch ex As Exception
msgText = "
Catie nemůže být nalezena mezi běžícími procesy." & vbCrLf
msgText &= "
Zkontroluj zda máš spušťenou Catii a spusť makro ještě jednou" & vbCrLf
msgText &= "
Pokud ji máš spuštěnou, může být něco s makrem, volej +420-604600585" & vbCrLf
MsgBox(msgText, vbExclamation, strCaption)
Exit Sub
End Try

objProdukt = GetProdukt(CATIA)
If IsNothing(objProdukt) Then Exit Sub 'nebyla přiřazena sestava - ukonči tuto proceduru, popř. přidat odezvu Do formuláře

colPodprodukty.Add(objProdukt)
colAssyLevel.Add(1)

ProduktExplorer(objProdukt, 1, colPodprodukty)

intMaxAssyLevel = colAssyLevel.Max


'EXLSheet.Cells(1, 1) = "Struktura sestavy" & objProdukt.Name
'EXLSheet.get_Range(EXLSheet.Cells(1, 1), EXLSheet.Cells(1, intMaxAssyLevel + 1)).Merge()

Dim RowEntering(intMaxAssyLevel + 1) As String
MyGrid.Columns.Add("
AssyLevel", "Assy Level")

For i As Integer = 1 To intMaxAssyLevel
MyGrid.Columns.Add("
PN" & CStr(i) & "Level", "Part Number" & vbCrLf & CStr(i) & ".Assy Level")
Next i
MyGrid.Columns.Add("
FileName", "File Name")
MyGrid.Columns.Add("
Changes", "Proceeded Changes")


For i As Integer = 0 To colPodprodukty.Count() - 1

'světlé odstíny červená, zelená, modrá
' intRed = CInt(155 + (50 + colAssyLevel.Item(i) / intMaxAssyLevel) * (colAssyLevel.Item(i) Mod 3))
' intGreen = CInt(155 + (50 + colAssyLevel.Item(i) / intMaxAssyLevel) * ((colAssyLevel.Item(i) + 1) Mod 3))
' intBlue = CInt(155 + (50 + colAssyLevel.Item(i) / intMaxAssyLevel) * ((colAssyLevel.Item(i) + 2) Mod 3))

For j As Integer = 0 To RowEntering.Count - 1
RowEntering(j) = "
"
Next

locProdukt = colPodprodukty.Item(i)
locDocument = CType(locProdukt.ReferenceProduct.Parent, Document)
intLevel = colAssyLevel.Item(i)

RowEntering(0) = CStr(intLevel)
RowEntering(intLevel) = locProdukt.PartNumber
RowEntering(intMaxAssyLevel + 1) = locDocument.FullName

MyGrid.Rows.Add(RowEntering)

Next i

Cursor.Current = Cursors.Arrow
btnChangePN.Enabled = True

End Sub

Public Sub New()

' This call is required by the designer.
InitializeComponent()

' Add any initialization after the InitializeComponent() call.
Me.Text = strCaption
MyGrid.Top = 30
MyGrid.Height = Me.Height - 56
MyGrid.Left = 0
MyGrid.Width = Me.Width - 7
btnChangePN.Enabled = False

End Sub

Private Sub frmOutputTable_SizeChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.SizeChanged
MyGrid.Top = 30
MyGrid.Height = Me.Height - 56
MyGrid.Left = 0
MyGrid.Width = Me.Width - 7

End Sub

Private Sub CleanGrid()
MyGrid.Rows.Clear()
MyGrid.Columns.Clear()

colAssyLevel.Clear()
colPodprodukty.Clear()
btnChangePN.Enabled = False

End Sub

Private Sub btnVycistit_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnVycistit.Click
CleanGrid()
End Sub


Private Sub btnChangePN_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnChangePN.Click
Dim locDocument As Document
Dim locProduct As Product
Dim PathCutted() As String
Dim OldNameCutted() As String
Dim strNewName, strOldPN As String
Dim strOldIndex As String


For i As Integer = 0 To colPodprodukty.Count() - 1
locProduct = colPodprodukty.Item(i)
locDocument = CType(locProduct.ReferenceProduct.Parent, Document)

strOldPN = locProduct.PartNumber
OldNameCutted = Split(locProduct.Name, "
.")
strOldIndex = OldNameCutted(OldNameCutted.Count() - 1)

strNewName = locDocument.FullName
PathCutted = Split(strNewName, "
\")
strNewName = PathCutted(PathCutted.Count() - 1)
If strNewName.Contains("
CATProduct") Then strNewName = strNewName.Remove(strNewName.Length - 11)
If strNewName.Contains("
CATPart") Then strNewName = strNewName.Remove(strNewName.Length - 8)

If Not strNewName = locProduct.PartNumber Then
locProduct.PartNumber = strNewName
locProduct.Name = strNewName & "
." & strOldIndex

MyGrid.Rows(i).Cells("
Changes").Value = "PN Change from: '" & strOldPN & "' to '" & strNewName & "'"

Dim MyStyle As New DataGridViewCellStyle()
MyStyle.ForeColor = Color.Red

MyGrid.Rows(i).Cells("
Changes").Style.ApplyStyle(MyStyle)

MyGrid.Rows(i).Cells(colAssyLevel(i)).Value = locProduct.PartNumber
End If




Next i
End Sub
End Class



Dana Janovská

Poslat zprávu | Profil
[#3334] | Publikováno: 11.09. 2012 - 07:58
Uživatel odpovídá na příspěvek #3264:


Uf .. DOKONALÉ.
Přejmenuje všem otevřeným partům PartName dle FileName.
Přejmenuje i díly v sestavě.

Tisícerý dík.
Břeťa Doležal

Poslat zprávu | Profil
[#3337] | Publikováno: 12.09. 2012 - 07:51
Uživatel odpovídá na příspěvek #3334:


Takze se to podarilo rozchodit? Jsem rad, pokud ano.
Tomáš Martinek

Poslat zprávu | Profil
[#3979] | Publikováno: 02.07. 2013 - 15:13
Dobrý den,
rád bych ještě obrátil pozornost k prvnímu makru v tomto vlákně – přejmenování souborů podle PartNumber. Je to mocný nástroj a v sestavě funguje naprosto dokonale včetně více úrovní, ale pokud makro spustím nad dílem, tak se zastaví u následující podmínky:

If oChild.Parameters.Item(oChild.Parameters.Count).ValueAsString = "true" Then



Nebylo by možné makro nějak jednoduše ošetřit i pro Part?

Děkuji
Tomáš Martinek
Ing Jan Cinert

Poslat zprávu | Profil
[#3981] | Publikováno: 02.07. 2013 - 16:02
Makro je primárně určeno na rekurzivní procházení struktury sestavy, tj. musela by se odstranit rekurze a místo objektů instancí brát přímo objekt Partu.

Pak ale v makru nevidím velký přínos.
Tomáš Martinek

Poslat zprávu | Profil
[#3982] | Publikováno: 02.07. 2013 - 16:04
Dobrá, zapomeňme tedy na to... jeden soubor opravdu není problém přejmenovat ;-)
Děkuji
Tomáš Němev

Poslat zprávu | Profil
[#6284] | Publikováno: 08.08. 2017 - 13:40
Dobrý den,
prosím o radu, jak dodělat makro na přepis partu, nejde mi nastavit změnu Part Numbr
Děkuji

Přiložené obrázky:

Ing Jan Cinert

Poslat zprávu | Profil
[#6285] | Publikováno: 08.08. 2017 - 16:26
Dobrý den, co přesně od toho chcete / očekáváte?

Tenhle kousek kódu přejmenuje pouze PartBody.
Tomáš Němev

Poslat zprávu | Profil
[#6286] | Publikováno: 09.08. 2017 - 06:18
Dobrý den,
chtěl bych aby mi přejmenoval PartBody a Part name abych nemusel lést do Propertis a přepisovat ho.
předem děkuji
Ing Jan Cinert

Poslat zprávu | Profil
[#6287] | Publikováno: 09.08. 2017 - 07:28
Aha, v tom případě nějak takhle:

Sub CATMain()

Set oPart = CATIA.ActiveDocument.Part
oPart.Parent.Product.PartNumber = InputBox("Zadejte nazev PartNumber")
oPart.Bodies.Item(1).Name = InputBox("Zadejte nazev PartBody")
End Sub


a pak byste si měl ošetřit výjimky, jako když je místo partu otevřena sestava (nebo nic), duplicitu PN a pod.
Tomáš Němev

Poslat zprávu | Profil
[#6288] | Publikováno: 09.08. 2017 - 09:20
Děkuji
Petr

Poslat zprávu | Profil
[#6790] | Publikováno: 07.03. 2020 - 11:06
Zdravím,
zkouším vytvořit makro na přejmenování souboru v catii part name = file name.

nemůžu přijít na to v čem je chyba, pokaždé se mi to zastaví na Set oDoc = oSubProduct

Děkuji za každou radu.

 

Sub CATMain()
Dim oProduct As Product
Dim oDocument As Document

Set oDocument = CATIA.ActiveDocument
Set oProduct = oDocument.Product
oProduct.ApplyWorkMode DESIGN_MODE

WalkThroughTree oProduct

MsgBox ("HOTOVO")


End Sub
Private Sub WalkThroughTree(ByVal oSubProduct As Product)
Dim oDoc As Document
Dim oSubProducts As Products
Dim RefValid As Boolean
Dim PartName, FileName, InstanceName, cesta As String

' nacteme vsechny instance v sestave

For Each oSubProduct In oSubProduct.Products
FileName = oSubProduct.ReferenceProduct.Parent.Name
PartName = oSubProduct.ReferenceProduct.PartNumber
cesta = oSubProduct.ReferenceProduct.Parent.Path

If PartName <> FileName Then
Set oDoc = CATIA.ActiveDocument
Set oDoc = oSubProduct
oDoc.SaveAs (cesta & PartName)


End If



If oSubProduct.Products.Count > 0 Then
WalkThroughTree oSubProduct
End If
Next


End Sub

Ing Jan Cinert

Poslat zprávu | Profil
[#6791] | Publikováno: 08.03. 2020 - 21:10
Dobrý den,

máte tam chybu - snažíte se do objektu oDoc (Document) přiřadit typ Product!!!

Respektive máte to úplně celé špatně - musíte pracovat s těmi objekty, které procházíte rekurzí, vy tam pořád cpete ActiveDocument....

Objekt oSubProduct.ReferenceProduct.Parent už je de facto vlastní dokument, na kterém bude fungovat metoda SaveAs.
Petr

Poslat zprávu | Profil
[#6927] | Publikováno: 09.03. 2021 - 13:27
Zdravim,
mám dotaz, je nějaký způsob jak do Catia VBA připdat DataGridView?

Děkuji za pomoc
Ing Jan Cinert

Poslat zprávu | Profil
[#6934] | Publikováno: 10.03. 2021 - 13:05
Uživatel odpovídá na příspěvek #6927:
Dobrý den,

tohle je na nové vlákno, tady to dost zapadne a hlavně to nesouvisí s tématem....


Uživatel nepřihlášen

Pro zobrazení obsahu stránky / provedení akce (vytvoření nového téma, napsání odpovědi do diskuse apod.) musíte být přihlášeni.