pondělí 1. prosince 2014

Převod Acad úseček na SCTN do Aveva PDMS

Při práci s PDMS občas potřebujete načíst nějakou grafiku z Autocadu pomocí datalu, toto je skript který vytvoří txt soubor, ves správné syntaxi pro tvorbu PDMS grafiky


Sub writdatal()

On Error Resume Next
ThisDrawing.SelectionSets.Item("oznac").Delete
If Err Then Err.Clear

MsgBox ("Vyber objekty pro převod do pdms, převedeny budou jen objekty typu line")

Dim line As AcadLine
Dim soubor As String
Dim startPoint As Variant
Dim endPoint As Variant

soubor = "c:\cad\output.txt"
soubor = InputBox("Zadej výstupní cestu", "Urči výstup", soubor)

Set objSelectionSet = ThisDrawing.SelectionSets.Add("oznac")

objSelectionSet.SelectOnScreen
Open soubor For Output As #1
For Each line In objSelectionSet

radek = "new sctn POSS N" & Round(line.startPoint(1), 0) & " E" & Round(line.startPoint(0), 0) & " U" & Round(line.startPoint(2), 0) & " POSE N" & Round(line.endPoint(1), 0) & " E" & Round(line.endPoint(0), 0) & " U" & Round(line.endPoint(2), 0)

Print #1, radek


Next

Close #1


objSelectionSet.Delete

End Sub


Nastavení Global width = 0 pro všechny polyline

Z programu Aveva PDMS 12.1 jsou generovány DXF soubory s nenulovou globalwidth u polyline
zde  je utilitka do Autocadu které u všech nastaví globalwidth=0


Sub zerothick()
'všem polyline ve výkrese nastaví globalwidth = 0
'deklarace
Dim intGroupCode(0) As Integer
Dim varDataCode(0) As Variant
Dim objAcadPoly As AcadLWPolyline 'deklarace jako objekt

' mazání starých selection setů

On Error Resume Next
intGroupCode(0) = 0
varDataCode(0) = "LWPolyline"
ThisDrawing.SelectionSets.Item("Poly").Delete
If Err Then Err.Clear

'select all
Set objSelectionSet = ThisDrawing.SelectionSets.Add("Poly")
objSelectionSet.Select acSelectionSetAll, , , intGroupCode, varDataCode

'cyklus prochází všechny poly v selekci, a nastaví Globalwidth = 0
For Each objAcadPoly In objSelectionSet
objAcadPoly.ConstantWidth = 0
Next objAcadPoly

End Sub