To agaragar ... děkuji, otestuji .
Častěji potřebuji přejmenovávat PartNumber dle FileName. Ale i toto je velmi častý otravný úkol.

PS: hlavne si vždy pred spúšťaním hociakého makra všetko zálohujte.

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?

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.

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.

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.

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é.

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

Uživatel odpovídá na příspěvek #3334:

Takze se to podarilo rozchodit? Jsem rad, pokud ano.

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.

Dobrý den,
prosím o radu, jak dodělat makro na přepis partu, nejde mi nastavit změnu Part Numbr
Děkuji

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

Děkuji

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.

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....