Zobrazit plnou verzi příspěvku: Export plechů ve složce do DXF (opět...)

IvoBe
12.02.2018, 16:01
Zdravím, hraji si s pravidly  iLogicu a zkouším udělat, co už se tu opakovaně řešilo (z fora jsem to taky víceméně opsal) - export rozvinů všech plechových dílů ve složce do DXF. Chci to vylepšit o to, že název souboru se bude vypadat např takto:4V-10101 - DÍL 1 - S235JR - T5(číslo výkresu - název dílu - materiál - tloušťka plechu)Když spustím část kódu mezi poznámkami ZAČÁTEK a KONEC  TĚLA CYKLU v (jednom) otevřeném plechovém dílu jako samostatné pravidlo, tak to funguje, takže ve skládání názvu souboru není problém.Když to ale zabalím do cyklu, tak se exportuje jen první díl s skončí to chybou.Mohl by se nějaký fanda na to kouknout prosím (dělám smutné oči na pana Navaru...)Děkuji a zdravím, Ivo BešťákPlechyDoDXF.iLogicVb------------------------------------------------------------------------parametry pro rozvin

'aktualni slozka
Dim sPath As String
sPath = (ThisDoc.Path & "\")

'vystupni slozka
Dim sOutDir As String
sOutDir="D:\DXF\"

'parametry rozvinu
Dim sSett As String
sSett = "FLAT PATTERN DXF?AcadVersion=2000" _
+"&InvisibleLayers=IV_BEND;IV_BEND_DOWN;IV_TANGENT;IV_TOOL_CENTER;IV_TOOL_CENTER_DOWN;IV_ARC_CENTERS;IV_ALTREP_FRONT;IV_ALTREP_BACK;IV_UNCONSUMED_SKETCHES;IV_ROLL_TANGENT;IV_ROLL" _
+"&SimplifySplines=True" _
+"&LINEAR TOLERANCE=0.1" _
+"&MergeProfilesIntoPolyline=True" _
+"&RebaseGeometry=False" _
+"&TrimCenterlines=True"

'oddelovac
Dim sSep As String
sSep = " - "

'vyber IPT souboru ve aktualni slozce
Dim files = IO.Directory.GetFiles(sPath,"*.ipt")

'cyklus pres IPT soubory
For Each file As String In files
Dim document = ThisApplication.Documents.Open(file)
If document.DocumentSubType.DocumentSubTypeID <> "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}" Then
document.Close()
Continue For
End If

'ZACATEK TELA CYKLU

'cislo vykresu
Dim sVykres As String
sVykres = iProperties.Value("Summary", "Title")
'MsgBox(sVykres, MessageBoxButtons.OKCancel)

'nazev dilu
Dim sNazev As String
sNazev = iProperties.Value("Summary", "Subject")
'MsgBox(sNazev, MessageBoxButtons.OKCancel)

'material
Dim sMatros As String
sMatros= iProperties.Material
'MsgBox(sMatros, MessageBoxButtons.OKCancel)

'tloustka plechu
Dim sTloustka As String
sTloustka = "T" & iProperties.Value("Custom", "SM_Thickness")
'MsgBox(sTloustka, MessageBoxButtons.OKCancel)

'poskladane jmeno vystupniho souboru
Dim fSname As String
sDXFFileName = sOutDir & sVykres & sSep & sNazev & sSep & sMatros & sSep & sTloustka & ".dxf"
' MsgBox(sDXFFileName, MessageBoxButtons.OKCancel)

'kdyz neexituje rozvin, tak se vytvori, kdyz existuje, tak se zaktivni
If ThisApplication.ActiveDocument.ComponentDefinition.HasFlatPattern = False Then
ThisApplication.ActiveDocument.ComponentDefinition.Unfold
Else
ThisApplication.ActiveDocument.ComponentDefinition.FlatPattern.Edit
End If

'vlastni export
ThisApplication.ActiveDocument.ComponentDefinition.DataIO.WriteDataToFile( sSett, sDXFFileName)

'prepnuti z rozvinu zpet
ThisApplication.ActiveDocument.ComponentDefinition.FlatPattern.ExitEdit

document.Close()'KONEC TELA CYKLU
Next
------------------------------------------uploads/627/plechy-do-DXF.zip

Vladimír Michl
12.02.2018, 16:12

To asi nepůjde mu takhle "pod rukama" měnit kontext dokumentu a chtít přistupovat na implicitní iProperties. Asi by ale šlo udělat smyčku ze sestavy, přes AllReferencedDocuments a k iVlastnostem pak přistupovat pomocí iProperties.Value(partDoc, "Summary", "Subject").

Navara
18.02.2018, 14:30


Dobrý den,Po dovolené a hned takový pěkný dotaz.  Já nejsem moc přítel používání těch zkratek v iLogicu jako jsou iProperties. Zejména protože nejsou dobře zdokumentované. Dávám přednost využívání standardního API pro iVlastnosti. Potom je možné snadno celý kód rozdělit na dvě části. Jedna (Main)se stará o nastavení a vyhledání souborů pro export a druhá (ExportDocumentToDxf) se stará o samotný export. V té druhé metodě jsem nahradil použití iProperties(...) za standardní API funkce a doplnil proměnné part a sheetmetalComponentDefinition. Z toho potom plynou drobné formální úpravy kódu. Pozor na používání ThisApplication.ActiveDocument. To nemusí být vždycky ten, nad kterým se spouští pravidlo. Když už používáte iLogic, použijte radši ThisDoc.Document, protože to je skutečně dokument, nad kterým vám budou fungovat funkce jako například iProperties().  [code]Sub Main()    'aktualni slozka    Dim sPath As String    sPath = (ThisDoc.Path & "\")    'vystupni slozka    Dim sOutDir As String    sOutDir = "D:\DXF\"    'parametry rozvinu    Dim sSett As String    sSett = "FLAT PATTERN DXF?AcadVersion=2000" _    + "&InvisibleLayers=IV_BEND;IV_BEND_DOWN;IV_TANGENT;IV_TOOL_CENTER;IV_TOOL_CENTER_DOWN;IV_ARC_CENTERS;IV_ALTREP_FRONT;IV_ALTREP_BACK;IV_UNCONSUMED_SKETCHES;IV_ROLL_TANGENT;IV_ROLL" _    + "&SimplifySplines=True" _    + "&LINEAR TOLERANCE=0.1" _    + "&MergeProfilesIntoPolyline=True" _    + "&RebaseGeometry=False" _    + "&TrimCenterlines=True"    'oddelovac    Dim sSep As String    sSep = " - "    'vyber IPT souboru ve aktualni slozce    Dim files = IO.Directory.GetFiles(sPath, "*.ipt")    'cyklus pres IPT soubory    For Each file As String In files        Dim document = ThisApplication.Documents.Open(file)        ExportDocumentToDxf(document, sOutDir, sSep, sSett)        document.Close() 'KONEC TELA CYKLU    NextEnd Sub Private Sub ExportDocumentToDxf(document As _Document, sOutDir As String, sSep As String, sSett As String)    ''Nadbytecne    'If part.DocumentSubType.DocumentSubTypeID <> "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}" Then    '    document.Close()    '    Return    'End If        Dim sheetmetalComponentDefinition As SheetMetalComponentDefinition    Dim part As PartDocument    Try        'Document is part        part = document        If part Is Nothing Then Return        'Part is SheetmetalPart        sheetmetalComponentDefinition = part.ComponentDefinition        If sheetmetalComponentDefinition Is Nothing Then Return    Catch        'Ignore eror and exit        Return    End Try     'ZACATEK TELA CYKLU     'cislo vykresu    Dim sVykres As String = part.PropertySets("{F29F85E0-4FF9-1068-AB91-08002B27B3D9}")("Title").Value    'sVykres = iProperties.Value("Summary", "Title")    'MsgBox(sVykres, MessageBoxButtons.OKCancel)     'nazev dilu    Dim sNazev As String = part.PropertySets("{F29F85E0-4FF9-1068-AB91-08002B27B3D9}")("Subject").Value    'sNazev = iProperties.Value("Summary", "Subject")    'MsgBox(sNazev, MessageBoxButtons.OKCancel)     'material    Dim sMatros As String = sheetmetalComponentDefinition.ActiveSheetMetalStyle.Material.Name    'sMatros = iProperties.Material    'MsgBox(sMatros, MessageBoxButtons.OKCancel)     'tloustka plechu    Dim sTloustka As String = "T" & part.PropertySets("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}")("SM_Thickness").Value    'sTloustka = "T" & iProperties.Value("Custom", "SM_Thickness")    'MsgBox(sTloustka, MessageBoxButtons.OKCancel)     'poskladane jmeno vystupniho souboru    Dim sDxfFileName = sOutDir & sVykres & sSep & sNazev & sSep & sMatros & sSep & sTloustka & ".dxf"    '    MsgBox(sDXFFileName, MessageBoxButtons.OKCancel)     'kdyz neexituje rozvin, tak se vytvori, kdyz existuje, tak se zaktivni    If sheetmetalComponentDefinition.HasFlatPattern = False Then        sheetmetalComponentDefinition.Unfold()    Else        sheetmetalComponentDefinition.FlatPattern.Edit()    End If     'vlastni export    sheetmetalComponentDefinition.DataIO.WriteDataToFile(sSett, sDxfFileName)     'prepnuti z rozvinu zpet    sheetmetalComponentDefinition.FlatPattern.ExitEdit() End Sub [/code]

Navara2018-02-18 14:47:52

huku
19.02.2018, 17:17

Dobrý den, Zmiňované pravidlo mi vykazuje chybu. Prosím o radu na její odstranění. DěkujiOuředník Miroslav

huku
19.02.2018, 18:38

Prosím, jak by se musel upravit tento zápis, aby se ukládal název souboru ipt. nikoli název dílu:'nazev dilu    Dim sNazev As String = part.PropertySets("{F29F85E0-4FF9-1068-AB91-08002B27B3D9}")("Subject").Value    'sNazev = iProperties.Value("Summary", "Subject")    'MsgBox(sNazev, MessageBoxButtons.OKCancel) Děkuji.Ouředník Miroslav