...der Ernst des Lebens

Einige kleine Makrobeispiele

Ich arbeite bei den Städtischen Werken in einer Abteilung zur Leitungsdokumentation. Es gibt also einen riesigen homogenen Datenbestand, den es gilt mit MicroStation zu beherrschen. Dazu bastele ich mir mit MicroStation-Basic, VBA und VB 6 kleine Helfer.

NameMix ist ein VB6-Progamm bei dem mit der FileSystemObject und der File-Klasse gearbeitet wurde. Die Dateien werden in eine Liste geschrieben. Anschließend werden Zufallszahlen in dem vorgegebenem Bereich erzeugt. Dies geschieht so lange, bis eine Zahl gefunden wird, die noch nicht vergeben wurde. Jetzt kann die Datei umbenannt werden.

Loop While Dir
     (Dir1.Path & "\" & NewName) <> ""
Set Dat = FS.GetFile
     (Dir1.Path & "\" & FileList(j))
Dat.Name = NewName
j = j + 1

FileStream objTxtFile = new FileStream(strTxtFile, FileMode.Open);
StreamReader objReader = new StreamReader(objTxtFile,
                             System.Text.Encoding.GetEncoding("iso-8859-1"));

while ((lstLine = LstReader.ReadLine()) != null)
   {
   ///Schleife, bis Zeichen in der Zeile nicht mehr vorkommt
    testStr=lstLine.Substring(1,(lstLine.Length)-1);
    newLine=newLine.Replace(lstLine.Substring(0,1),
                            lstLine.Substring(1,(lstLine.Length)-1));
   }
LstReader.Close();
objWriter.WriteLine(newLine + "<br>");

Text,RW_Lu,HW_Lu,Ebene,RW_Fa,HW_Fa,Farbe,Index
Autobus,-38.556675,-0.576831,0,,,7,1
Autobus,-25.150845,3.771006,0,,,12,2
Bahnhof,-31.49144,-8.823225,0,,,9,3
Wasserwerk,-43.810311,5.669564,0,,,3,4

Text        RW_Lu       HW_Lu      Ebene  RW_Fa  HW_Fa  Farbe  Index
Autobus     -38.556675  -0.576831  0                     7     1
Autobus     -25.150845   3.771006  0                    12     2
Bahnhof     -31.49144   -8.823225  0                     9     3
Wasserwerk  -43.810311   5.669564  0                     3     4

open dxfFile for Input Access Read Shared As #1
do while not eof(1)
  line input #1,kette(20)                   'Zeile zur Liste hinzufügen
  i% = 0
  do while i < 20
    kette(i) = kette(i+1)                   'Liste neu ordnen
    i = i + 1
  loop
  if kette(19)="POINTNUMBER" and kette(17)="AcDbAttribute" then
    mPoint.x = val(kette(7))                'Koordinaten auslesen
    mPoint.y = val(kette(9))                'Koordinaten auslesen
    pktNr    = kette(15)                    'Text auslesen
    MbeSendCommand "PLACE DIALOGTEXT ICON"
    MbeSetAppVariable "", "msToolSettings.placeText.type", 0&
    MbeSendAppMessage "TEXTEDIT", "FirstLine " & pktNr
    MbeSendDataPoint mPoint, 1%             'Text plazieren
  end if
loop
close #1

Set nLine = CreateLineElement2(Nothing, Point1, Point2)
nLine.Redraw msdDrawingModeTemporary

'Richtung x1x2
tt = 1 / Sqr((x1 - x2) * (x1 - x2) + (y1 - y2) * (y1 - y2))

'Länge P1-Pf
a = Sqr((x3 - x2) * (x3 - x2) + (y3 - y2) * (y3 - y2))
b = ((x1 - x2) * (x3 - x2) + (y1 - y2) * (y3 - y2)) / (a * c)
h = a * Sqr(1 - (b * b))
p = c - b * a

'Fußpunkt P4
Point4.X = x1 + tt * (x2 - x1) * p
Point4.Y = y1 + tt * (y2 - y1) * p
Point4.Z = 0

Set nText = CreateTextElement1(Nothing, x2point(rText, dezTr), Point3, rotMatrixZ(r))
ActiveModelReference.AddElement nText
nText.Redraw

filePos = element.fromFile(0)
Do While filePos >= 0 and chkSum > 0
  if element.level>0 and element.color>-1 and element.weight>-1 then

    MbeWriteStatus "props " & cstr(element.properties) & " --> " & cstr(optSum)
    element.properties = optSum

    status = element.rewrite()
    element.display MBE_NormalDraw

  end if
  filePos = element.fromFile (filePos + element.fileSize)
Loop

'Einlesen der Endpunktkoordinaten


if element.getPoints (gpoint) = MBE_Success Then

'Test, ob das Element eine Linie ist
 if ((element.type = 3) and (element.level < 63)) then

'Koordinaten auslesen
   xx0# = gpoint(0).x
   xx1# = gpoint(1).x
   yy0# = gpoint(0).y
   yy1# = gpoint(1).y

'Test, ob die Länge kleiner als (hier) 1mm ist
   if (sqr(((xx0-xx1)*(xx0-xx1))+((yy0-yy1)*(yy0-yy1)))<0.001) then

'neue Ebene und Farbe zuweisen
     element.color = 1
     element.level = 4
     stat = element.rewrite ()
   end if
 end if
end if

sub main
  Dim Element as New MbeElement
  Dim FilePos as Long
  Dim flag    as integer

  dgnDummy$ = MbeDgnInfo.dgnFileName             'Name der geöffneten Datei
  dgnPath$  = FileParse$(dgnDummy,2) & "\"       'Pfad der geöffneten Datei
  dgnfile$  = LCase$(Dir$(dgnPath & "*.dgn"))

  while (dgnfile <> "")
    mbeSendCommand ("NEWFILE " & dgnPath & dgnFile)   'neue DGN öffnen
      flag = 0
      filePos = element.FromFile (0)
      do while filePos >= 0                           'DGN durchsuchen
        if element.level > 0 and element.color > 0 then
          flag = 1
          exit do
        end if
        FilePos = element.FromFile (filePos + Element.FileSize)
      loop
    if flag = 0 then
      mbeSendCommand ("NEWFILE " & dgnDummy)
      kill dgnPath & dgnFile                            'Datei löschen
    end if
    dgnFile$ = LCase$(Dir$())                  'nächsten Dateinamen lesen
  wend
end sub

do
  status = element.getString(OrgText)
  EleText = EleText & OrgText
  OrgText = ""
  status = element.nextComponent
loop while status = MBE_Success

xx% = Instr(EleText,fText)        'Test, ob Teiltext enthalten ist
'xx% = 1                          'zum Auslesen aller Texte auskommentieren

element.getOrigin(origin)         'Koordinaten an die Variable origin übergeben

status = mbeOpenModalDialog (1)

if status <> MBE_BUTTON_OK then exit sub

DesignFile$ = Dir$(Directory$ & "*.dgn")
While DesignFile <> ""
  MbeSendCommand "NEWFILE " & Directory & DesignFile     'Datei öffnen
  ....
  DesignFile = Dir$
Wend

MbeSendCommand "FIT VIEW EXTENDED 1"
MbeSetAppVariable "VIEWCTRL", "dialogInfo.p.zoomRatio", 2#
MbeSendCommand "ZOOM OUT EXTENDED 1"

if element.Type = 17 then
  status = element.getString(DgnText)                    'Zeichenfolge auslesen
  if DGNText = OrgText then                              'Zeichenfolge vergleichen
    if element.setString (NewText) = MBE_Success then    'neue Folge zuweisen
      status = element.rewrite ()                        'Änderungen übernehmen
    else
      MbeWriteError ("Zeichenfolge kann nicht geändert werden")
    end if
  end if
end if