editace textu dxf pro vb.net

Můj pokus ve vb.netu   o konzolovou aplikaci která pomocí argumentů zpracovává  dxf soubory
stručně: 
nejde řádek polyline 
pokud na 9 řádku od polyline je hodnota " 40" tan na další řádku zapíše "0"
pokud na 11 řádku od polyline je hodnota " 41" tan na další řádku zapíše "0"

celé to slouží k tomu aby z PDMS lezly polyline s tloušťkou nastavenou na 0, kvůli správnému CTB tisku v autocadu. 

kód: 

Imports System.IO

Module Module1

    'Sub Main(ByVal args() As String)

    Sub Main()

        Dim argus As String() = Environment.GetCommandLineArgs()

        If argus.Length = 1 Then

            Console.WriteLine("Help -this app read dxf file and search value 0.100000E-01 and replacet to 0 ")

            Console.WriteLine("sytax: zerothic.exe c:\file.dxf")

            Console.WriteLine("output is same filename with !-prefix")

            Exit Sub

        End If

        Dim ZdrFile As String = argus(1)

        If Not Path.GetExtension(ZdrFile) = ".dxf" Then

            Console.WriteLine("Error - File must be dxf type")

            Exit Sub

        End If

        If Not My.Computer.FileSystem.FileExists(ZdrFile) Then

            Console.WriteLine("Error - File doesnt' exist")

            Exit Sub

        Else

        End If

        Dim f As Integer = FreeFile()

        Dim TextLine As String = ""

        Dim CilFile As String

        CilFile = Path.GetDirectoryName(ZdrFile) & "\!" & Path.GetFileName(ZdrFile)

        Dim objReader As New System.IO.StreamReader(ZdrFile)

        Dim objWriter As New System.IO.StreamWriter(CilFile)

        Dim CisloRadek As Integer = 1

        Dim polyradek As Integer

        Dim zpracuj As Boolean = False

        Do While objReader.Peek() <> -1

            TextLine = TextLine & objReader.ReadLine()

            If zpracuj = True Then

                objWriter.Write("0" & vbNewLine)

                zpracuj = False

            Else

                If TextLine = "POLYLINE" Then

                    polyradek = CisloRadek

                End If

                If ((CisloRadek = polyradek + 7) And (TextLine = " 40")) Or ((CisloRadek = polyradek + 9) And (TextLine = " 41")) Then

                    zpracuj = True

                End If

                objWriter.Write(TextLine & vbNewLine)

                TextLine = ""

            End If

            CisloRadek = CisloRadek + 1

            TextLine = ""

        Loop

        objWriter.Close()

    End Sub

End Module

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

Autocad VBA Open Drawings

Jak pomocí makra pro Autocad otevřít hromadně více výkresů a provést naplánovanou akci? 

Public cesta As String
Public adresar As String
Public Soubory As String

Sub dxf2dwg()
'toto je cyklus ktery projde ve složce c:\prevod všechny dxf soubory
'cyklus projde jeden za druhým a na kažkém spustí funkci openDXF
adresar = "c:\prevod\" ' cesta se kterou se pracuje

Soubory = Dir(adresar & "\*.dxf") ' možno změnit na .dwg apod.
Do While Soubory <> ""

    cesta = adresar & Soubory ' sestaví cestu "c:\prevod\aaa.dxf"
    Debug.Print Soubory
    opendxf ' volá funkci open dxf
    ' zde je možné přidat dlaší procedury
    Soubory = Dir
    Loop
End Sub

Function opendxf()

ThisDrawing.Application.Documents.Open cesta  'otevře "c:\prevod\aaa.dxf"

Dim newLimits(0 To 3) As Double     'autocad klasika, deklarace souřadnic
    newLimits(0) = 0#: newLimits(1) = 0#: newLimits(2) = 594#: newLimits(3) = 420#
ThisDrawing.Limits = newLimits  ' nastavení limit
ThisDrawing.Regen acActiveViewport ' regen
' zde je mozno pridat další sekvenvi prikazu

ZoomAll ' nocomment
newnazaev = adresar & Replace(Soubory, ".dxf", ".dwg") 'sestavení cesty pro uložení
ThisDrawing.SaveAs (newnazaev) ' uloží jako
ThisDrawing.Close 'zavře výkres

End Function

Toto je konkrétní makro které otevře soubory *.dxf v c:\prevod\