Uživatel | Příspěvek |
Dana Janovská
Poslat zprávu |
Profil
|
Datum:
23.8. 2012
| Zobrazeno:
15486xKonfigurace 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:38Dobrý 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
tmp = SPLIT(oChild.Name,".")
oChild.Name = oChild.PartNumber & "." & tmp(UBOUND(tmp))
If oChild.Products.Count = 0 THEN
SaveAsPartNumber oChild.ReferenceProduct
ELSE
WalkThroughTree oChild.ReferenceProduct
End IF
End IF
End IF
NEXT
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 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:26Dobrý 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
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
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
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:33Ak 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
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
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
oItemToRename.Name = ItemPartNumber & "." & oDict.Item(ItemPartNumber)
NEXT
oDict.RemoveAll
End SUB
|
Dana Janovská
Poslat zprávu |
Profil
|
[#3246]
| Publikováno:
24.08. 2012 - 14:38Pro 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:50Už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:12Už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:26Ak 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
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:57Už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
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
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
Public Function GetProdukt(ByVal iCATIA As INFITF.Application) As Product
Dim Soubor As String
Dim objDocument As Document
Dim blnSestavaOtevrena As Boolean = False
Do
Try
objDocument = iCATIA.ActiveDocument If TypeName(objDocument) = "ProductDocument" Then Return (CType(objDocument.Product, Product))
Else
msgText = TypeName(objDocument) & " nemůže být použit pro toto makro" & vbCrLf Sestava (CATProduct) musí být načtená a aktivní pro toto makro!"
If JeKonec(msgText) Then Return (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 Return (Nothing) End If
End Try
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 Return (Nothing) End If
Else
Try
iCATIA.Documents.Open(Soubor)
blnSestavaOtevrena = True Catch ex As Exception
msgText = "Sestavu nelze otevřít!"
If JeKonec(msgText) Then Return (Nothing) End If
End Try
End If
Loop Until blnSestavaOtevrena
Loop
End Function
Public Sub ProduktExplorer(ByVal iProdukt As Product, ByVal iAssyLevel As Integer, ByVal iPodprodukty As Collections.Generic.List(Of Product))
Dim locProdukty As Products Dim locProdukt As Product 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) Next locProdukt
intAssyLevel -= 1
End Sub
Public Function GetMaxLevel(ByVal iAssyLevels As System.Collections.Generic.List(Of Integer)) As Integer
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
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()
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
colPodprodukty.Add(objProdukt)
colAssyLevel.Add(1)
ProduktExplorer(objProdukt, 1, colPodprodukty)
intMaxAssyLevel = colAssyLevel.Max
Struktura sestavy" & objProdukt.Name
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
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()
InitializeComponent()
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: 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:58Už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:51Už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:13Dobrý 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:28Aha, 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:06Zdraví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
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:05Už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.... |