Autor
|
Thema: Allcatpart with Source-Body colors (661 / mal gelesen)
|
Sylas Mitglied
![](/foren/ubb/star3.gif) ![](/foren/ubb/star3.gif)
![Schreiben Sie einen Gästebucheintrag für Sylas](/foren/ubb/pmimages/gbu.gif) Beiträge: 344 Registriert: 19.11.2012 Dell Precision T3500 Intel Xeon W3550 @ 3,07 GHz 12 GB RAM CATIA V5 R28
|
erstellt am: 13. Sep. 2023 12:17 <-- editieren / zitieren --> Unities abgeben: ![1 Unity (wenig hilfreich, aber dennoch)](/foren/ubb/z1.gif) ![2 Unities](/foren/ubb/z2.gif) ![3 Unities](/foren/ubb/z3.gif) ![4 Unities](/foren/ubb/z4.gif) ![5 Unities](/foren/ubb/z5.gif) ![6 Unities](/foren/ubb/z6.gif) ![7 Unities](/foren/ubb/z7.gif) ![8 Unities](/foren/ubb/z8.gif) ![9 Unities](/foren/ubb/z9.gif)
Hello Community! I need your help again ![](/foren/ubb/zwinker.gif) I'm trying to write a macro,which will basically create an allcatpart form product, but at the same time copy source body color for the target body ![](/foren/ubb/zwinker.gif) At the end: I want allcatpart with original colors. Here what I have so far: Code:
Sub main() Dim oSource As Product Dim oDummy_sel As Selection Dim oTarget As Product Dim oSel Set oDummy_sel = CATIA.ActiveDocument.Selection Set oSel = oDummy_sel oDummy_sel.Clear oSel.Clear Dim InputObjectType(0) Dim Status InputObjectType(0) = "Product" 'choose target part Status = oSel.SelectElement3(InputObjectType, "Wska¿ part docelowy", True, CATMultiSelTriggWhenUserValidatesSelection, False) Set oTarget = oSel.Item(1).value '.Part oSel.Clear'choose source assembly Status = oSel.SelectElement3(InputObjectType, "Wska¿ produkt Ÿród³owy", True, CATMultiSelTriggWhenUserValidatesSelection, False) oDummy_sel.Search ("((((FreeStyle.Body + 'Part Design'.Body) + 'Generative Shape Design'.Body) + 'Functional Molded Part'.Body) + 'Functional Molded Part'.Body),sel") 'creates collection of bodies to copy Dim oCol As New VBA.Collection For i = 1 To oDummy_sel.Count oCol.Add oDummy_sel.Item(i).value Next oDummy_sel.Clear Dim Vis_prop As VisPropertySet Set Vis_prop = oDummy_sel.VisProperties Dim r As Long Dim g As Long Dim b As Long 'loop through bodies collection For i = 1 To oCol.Count oDummy_sel.Add oCol.Item(i) Set Vis_prop = oDummy_sel.VisProperties Vis_prop.GetRealColor r, g, b oDummy_sel.Copy oDummy_sel.Clear oDummy_sel.Add oTarget.ReferenceProduct.Parent.Part.Bodies oDummy_sel.PasteSpecial "CATPrtResultWithOutLink" Vis_prop.SetRealColor r, g, b, 0 oDummy_sel.Clear oTarget.Update Next End Sub
The problem is: when I hava complex product (~2k of bodies) CATIA hangs and I need to terminate it. Could you take a look and check what is wrong with my code? Thanks in advance Lucas Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Randle Mitglied CAD/PLM Consultant
![](/foren/ubb/star3.gif) ![](/foren/ubb/star3.gif) ![](/foren/ubb/star3.gif)
![Schreiben Sie einen Gästebucheintrag für Randle](/foren/ubb/pmimages/gbu.gif) Beiträge: 714 Registriert: 12.04.2003 Win10 x64 CATIA V5 R18, R19, R21, R27-29
|
erstellt am: 13. Sep. 2023 15:13 <-- editieren / zitieren --> Unities abgeben: ![1 Unity (wenig hilfreich, aber dennoch)](/foren/ubb/z1.gif) ![2 Unities](/foren/ubb/z2.gif) ![3 Unities](/foren/ubb/z3.gif) ![4 Unities](/foren/ubb/z4.gif) ![5 Unities](/foren/ubb/z5.gif) ![6 Unities](/foren/ubb/z6.gif) ![7 Unities](/foren/ubb/z7.gif) ![8 Unities](/foren/ubb/z8.gif) ![9 Unities](/foren/ubb/z9.gif) Nur für Sylas
Hello so in general your macro is running. That it will crash with you, I suspect, is due to the amount of bodies to be copied. Apart from that, you have the problem with your macro that only the body of the first instance copies repeat parts. Greetings Randle
------------------ Planung ersetzt Fehler durch Irrtum! Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
| Anzeige.:
Anzeige: (Infos zum Werbeplatz >>)
![](https://ww4.cad.de/books/view.php?what=zone:11371&n=s11371BB) |