![](../cz/img/nic.gif)
Diskuzní fórum, poradna
|
![CAD Fórum - Homepage CAD Fórum - Homepage](forum_images/web_wiz_forums.png)
Fórum nenahrazuje technický support firmy Arkance Systems (CAD Studio) - přímá podpora pro zákazníky funguje na helpdesk.cadstudio.cz
|
Odpovědět ![]() |
archiv |
Autor | |
carlosiiino ![]() Nováček ![]() Přihlášen: 17.úno.2016 Lokalita: ČR (JM) Používám: Inventor, AutoCAD Stav: Offline Bodů: 6 |
![]() Zasláno: 06.dub.2016 v 13:28 |
Dobrý den, mám vytvořené pravidlo pro export rozvinů plechových součástí (viz.níže), ale potřebuji do kódu nějak zakombinovat, aby vyhledal jen plechové součásti a ne objemové. Může mi někdo poradit ? Děkuji Sub Main() Dim sFile As String, sInDir As String, sOutDir As String, I As String Dim oDocs As Documents, oDoc As Document oDocs = ThisApplication.Documents 'Cesta pro otevření a uložení souboru sInDir = (ThisDoc.Path & "\") sOutDir = (ThisDoc.Path & "\DXF\") sFile = Dir(sInDir) While (sFile <> "") 'Definice formatu souboru pro otevření (IPT, IAM, IDW...) If (Right(sFile, 3) = "ipt") Then Debug.Print (sFile) oDoc = oDocs.Open(sInDir & sFile, False) ' Vytvořit objekt DataIO Dim oDataIO As DataIO oDataIO = oDoc.ComponentDefinition.DataIO ' Parametry definující formát výstupního souboru DXF Dim sParam As String sParam = "FLAT PATTERN DXF?AcadVersion=2000" ' Vytvořit výstupní DXF soubor v adresáři Dim sDXFFileName As String sDXFFileName = (sOutDir & Left(sFile, Len(sFile) - 3) & "DXF") MessageBox.Show(sDXFFileName, " CESTA SOUBORU") oDataIO.WriteDataToFile (sParam, sDXFFileName) End If sFile = Dir End While End Sub |
|
![]() |
|
Navara ![]() Profil člena
Odeslat soukromou zprávu
Najít příspěvky člena
Navštívit stránky člena
Přidat do seznamu známých
Arkance Systems support ![]() ![]() Arkance Systems Přihlášen: 08.zář.2008 Lokalita: ČR (Pha) Používám: Inventor Stav: Offline Bodů: 1637 |
![]() |
Lze porovnat vlastnost DocumentSubTypeID
|
|
![]() |
|
carlosiiino ![]() Nováček ![]() Přihlášen: 17.úno.2016 Lokalita: ČR (JM) Používám: Inventor, AutoCAD Stav: Offline Bodů: 6 |
![]() |
Dobrý den, děkuji za rychlou reakci. Upravený kód níže. Děkuji Sub Main() Dim sFile As String, sInDir As String, sOutDir As String, I As String Dim oDocs As Documents, oDoc As Document oDocs = ThisApplication.Documents 'Cesta pro otevření a uložení souboru sInDir = (ThisDoc.Path & "\") sOutDir = (ThisDoc.Path & "\DXF\") sFile = Dir(sInDir) While (sFile <> "") 'Definice formatu souboru pro otevření (IPT, IAM, IDW...) If (Right(sFile, 3) = "ipt") Then Debug.Print (sFile) oDoc = oDocs.Open(sInDir & sFile, False) If oDoc.DocumentSubType.DocumentSubTypeID <> "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}" Then Continue While ' Vytvořit objekt DataIO Dim oDataIO As DataIO oDataIO = oDoc.ComponentDefinition.DataIO ' Parametry definující formát výstupního souboru DXF Dim sParam As String sParam = "FLAT PATTERN DXF?AcadVersion=2000&InvisibleLayers=IV_TANGENT;IV_BEND;IV_BEND_DOWN" ' Vytvořit výstupní DXF soubor v adresáři Dim sDXFFileName As String sDXFFileName = (sOutDir & Left(sFile, Len(sFile) - 3) & "DXF") MessageBox.Show(sDXFFileName, " CESTA SOUBORU") oDataIO.WriteDataToFile (sParam, sDXFFileName) oDoc.Close(True) End If sFile = Dir End While End Sub |
|
![]() |
|
Navara ![]() Profil člena
Odeslat soukromou zprávu
Najít příspěvky člena
Navštívit stránky člena
Přidat do seznamu známých
Arkance Systems support ![]() ![]() Arkance Systems Přihlášen: 08.zář.2008 Lokalita: ČR (Pha) Používám: Inventor Stav: Offline Bodů: 1637 |
![]() |
Myslím, že to dělá ten cyklus While, kde v případě, že to není plech, nedojde k nastavení na další název souboru a smyčka se zasekne.
Já dávám přednost použití cyklu For Each, kde jako kolekci pro procházení použiju seznam všech souborů v daném adresáři.
|
|
![]() |
|
Navara ![]() Profil člena
Odeslat soukromou zprávu
Najít příspěvky člena
Navštívit stránky člena
Přidat do seznamu známých
Arkance Systems support ![]() ![]() Arkance Systems Přihlášen: 08.zář.2008 Lokalita: ČR (Pha) Používám: Inventor Stav: Offline Bodů: 1637 |
![]() |
Teoreticky by se dalo použít něco na tenhle způsob, ale ani Microsoft to nedoporučuje.
|
|
![]() |
Pro technickou podporu CAD
kontaktujte Helpdesk
Odpovědět ![]() |
|
Přejít na fórum | Oprávnění fóra ![]() Nemůžete vytvářet nová témata v tomto fóru Nemůžete odpovídat na témata v tomto fóru Nemůžete vymazávat vaše příspěvky v tomto fóru Nemůžete upravovat vaše příspěvky v tomto fóru Nemůžete vytvářet ankety v tomto fóru Nemůžete hlasovat v anketách v tomto fóru |
Stránka byla vygenerována za 1,273 sekund.