---

Ola Gemeinde,

so weiter gehts. Nachdem ich jetzt die Flächenstempel und die Flächenliste nach bedarf erstellt habe, frage ich mich ob ich nicht auch noch die Koordinaten der Fläche auswerten kann. Das einzige was ich im Eigenschaftsdefinitionsatz gefunden habe ist die Referenznummeraber leider keine Angaben zu den Koordinaten.
Hintergrund ist folgender: Ich möchte in einer Access-Datenbank den DWF Viewer einbinden und über die in Access eingelesenen Koordinaten aus der Flächenliste automatisch auf den Ausschnitt des Raumes zoomen können.

Grüße aus HH,
Elav

------------------

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Nun, das wird wohl nicht ganz trivial. In den Bauteildaten direkt gibt es meines Wissens keine Möglichkeit die Daten unterzubringen (und es würde sich auch die Frage nach dem "wie" stellen, denn die Fläche kann ja nahezu beliebig viele Eckpunkte haben.
Bleibt also noch der Weg über die Programmierung:
Richtig komfortabel ists wohl nur für ADN-Mitglieder, denn die kommen meines Wissens direkt an die Koordinaten.
In VBA gehts nicht so einfach, da könnte man höchstens die Fläche kopieren, mit _explode zerlegen, aus den dann entstehenden Linien die Koordinaten ermitteln und anschließend den temporären Geometriemüll wieder entsorgen.
Bleibt also noch Lisp. Leider sind die Elementdaten der ADT-Objekte nicht dokumentiert (und auch manchmal eher mühselig zu verarbeiten) aber mit der Methode des "scharfen Ansehens" kann man schon einiges erkennen. Folgendes Lispprogramm liefert die Eckpunkte einer Fläche zurück:

(defun c:testit()
  (getAreaPoints (entget (car (entsel))))
)

(defun r2d(w)
  (* (/ w pi) 180)
)

;defun getAreaPoints
(defun getAreaPoints(ed / result entry origin x-dir ringcnt incurve2d entyp endat ingesegments nrofpoints)
  (if (equal "AEC_AREA" (cdr (assoc 0 ed)))
    (progn
      (setq
result nil incurve2d nil ingesegments nil nrofpoints nil
origin  (cdr (assoc 10 ed))
x-dir  (cdr (assoc 15 ed))
ringcnt (cdr (assoc 90 ed))
      )
      (command "_ucs" "_world")
      (command "_ucs" "_origin" origin)
      (command "_ucs" "_z" (r2d (angle '(0 0) x-dir)))
      (foreach entry ed
(setq
  entyp (car entry)
  endat (cdr entry)
)
(cond
  ((equal entyp 102)
    (cond
      ((equal endat "{ACGECURVE2D") (setq incurve2d T))
      ((equal endat "ACGECURVE2D}") (setq incurve2d nil))
      ((equal endat "{AECGESEGMENTS") (setq ingesegments T))
    )
  )
  ((and ingesegments (equal entyp 90) (not nrOfPoints))
    (setq nrOfPoints endat)
  )
  ((and (equal entyp 280) (equal endat 1))
    (progn
      (princ "\nUps, Fläche hat einen Bogen. Dies ist noch nicht implementiert")
      (setq incurve2d nil)
    )
  )
) 
(if incurve2d
  (progn
    (if (and (equal entyp 10) (< (length result) nrOfPoints))
      (setq
result (cons (trans endat 1 0) result)
incurve2d nil
      )
    )
  )
)
      )
    )
  )
  (command "_ucs" "_world")
  result
)

Das Programm berücksichtig nur den ersten Ring, der aber nach meinen Erkenntnissen eh der äussere ist. Bögen in der Fläche werden auch noch nicht verarbeitet. Das command-ucs-Gelumpe kann man sicher auch eleganter lösen, aber es erfüllt so seinen Zweck und sollte für weitere eigene Arbeiten zunächst reichen.

Frohes Pfingsten.

sayonara
Torsten Möhlenhoff
ACAD-Systemhaus Bremen

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hi Torsten,

> Bleibt also noch Lisp.
> Leider sind die Elementdaten der ADT-Objekte nicht dokumentiert ...

Sind sie es unter VBA ??
Ich weiss nicht, aber wenn ich zB. auf AecArea ein F1 mach' kommt Schlüsselwort
nicht gefunden. Ich kann mich also maximal mit F2 ganz bescheiden ranhangeln.

Zu elav's Prob',
vielleicht täts ja auch schon ein einfaches GetBoundingBox?

lg Nancy 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Wie bereits geschrieben kommt man meines Wissens (!!!) mit VBA nicht an die Punkte der Fläche. Man kann sich zwar ein aecarea-Objekt besorgen, die Eckpunkte gibt selbiges aber leider nicht her. Ich kenne leider nur den Weg über Lisp und soweit ich gelesen habe, bekommt man die Punkte als ADT-Mitglied aus dem OMF.

Ich lasse mich da aber auch gerne eines besseren belehren.

Zum GetBoundingBox:

Geniale Idee. Schade, dass man selbst auf die einfachsten Dinge immer erst zuletzt oder gar nicht kommt, aber dafür gibt's ja dieses Forum  . Dann eben so (ebenfalls noch auszuarbeiten):

Sub GetAreaBoundingBox()

Dim adtDoc As AecArchBaseDocument
Set adtDoc = AecArchBaseApplication.ActiveDocument

Dim obj As AcadEntity
Dim pt As Variant
Dim minExt As Variant
Dim maxExt As Variant

Dim adtObj As AecArea

adtDoc.Utility.GetEntity obj, pt
If Not (TypeOf obj Is AecArea) Then
  MsgBox "Not an AecArea!"
End If

Set adtObj = obj
   
adtObj.GetBoundingBox minExt, maxExt

End Sub

sayonara
Torsten Möhlenhoff
ACAD-Systemhaus Bremen

[Diese Nachricht wurde von tmoehlenhoff am 30. Mai. 2004 editiert.]

[Diese Nachricht wurde von tmoehlenhoff am 31. Mai. 2004 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hi Torsten,

ich wollte das mit den Koordinaten ja nicht in Frage stellen,
sondern ganz pauschal nur wissen, ob es überhaupt eine VBA-Hilfe zu Aec-Objekten/Methoden gibt 

Und mal noch ne s##dumme  Frage, wo ist der Unterschied zwischen:

AecArchBaseApplication.ActiveDocument
und dem reinen ACAD-Object zB. ThisDrawing ??

da ja in dem Falle ein thisdrawing.Utility.GetEntity obj, pt ebenfalls tut.

Sorry fürs Nerven und nen schönen Pfingstmontag noch
lg Nancy

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Sorry, da habe ich wohl was grundsätzlich falsch verstanden.
Nun ja, es gibt schon einiges an Doku in den mitgelieferten Hilfedateien, immer werde ich da allerdings auch nicht fündig.

AecArchBaseApplication.ActiveDocument kann halt ein bisschen mehr als ThisDrawing. Man findet dort alles was ThisDrawing auch hat und darüber hinaus z.B. auch die verschiedenen ADT-Stildefinitionen  (Wände, Fenster, Türen usw.) der Zeichnung.
Es stimmt allerdings schon ,dass es in diesem Fall nicht nötig gewesen wäre.

Reduzieren wir also auf das Notwendige (den Export nach Access kann man dann ja wieder reinfrickeln ;-):

Sub GetAreaBoundingBox()

  Dim obj As AcadEntity
  Dim pt As Variant
  Dim minExt As Variant
  Dim maxExt As Variant

  ThisDrawing.Utility.GetEntity obj, pt
  If Not (TypeOf obj Is AecArea) Then
    MsgBox "Not an AecArea!"
  End If

  obj.GetBoundingBox minExt, maxExt

End Sub

BTW: Nervt doch gar nicht 

sayonara
Torsten Möhlenhoff
ACAD-Systemhaus Bremen

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Vielen Dank für die Hilfe ?
Das Makro läuft durch, jedoch werden am Ende die Variablen maxExt und minExt nicht gefüllt. Also ich bekomm keine Infos über die Ausdehnung.

Gruß aus Hamburg
Elav

------------------

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Kann ich mir kaum vorstellen (wobei das Programm die Variablen ja auch nur füllt, ohne weiter was damit anzufangen).

Wenn man vor End Sub noch

  MsgBox "Min:" & minExt(0) & ";" & minExt(1)
  MsgBox "Max:" & maxExt(0) & ";" & maxExt(1)

einbaut wird aber schon was angezeigt, oder?

sayonara
Torsten Möhlenhoff
ACAD-Systemhaus Bremen

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Thorsten,

jo klappt prima. Ich habe jetzt noch "roomNr = obj.ObjectID" dann gibt er mir auch brav die ObjektID zurück. Ich brauch aber eigentlich die Referenz Nummer des "Angeklebten" Flächenstempel um die Informationen dann zusammenzuführen "Koordinate + Raumnummer".
geht das mit AecViewBlock - MVBlockRef.

Auf jeden Fall ein prima Support von Dir - Mille grazie aus HH
Elav

------------------

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hi Torsten,

ich danke Dir 

Gruss Nancy

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Ola Gemeinde,

mit meinem Kollegen, seines Zeichens VBA Meister haben wir das Ding in den Griff bekommen. Wäre aber nicht geglückt ohne Eure (Torsten und startrek) Hilfe. Jetzt schreibt er die BoundingBox Koordinaten jeder AEC Fläche in eine SQL Tabelle  mit Referenznummer die gleich der Referenznummer aus der Bauteiltabelle ist.

Mille Grazie aus HH

Armin
das ganze Ding sieht jetzt so aus

Option Explicit

Sub Koordinaten_auslesen()
    Dim strHandle As String, minExt As Variant, maxExt As Variant, Ent As AcadEntity
    Dim SQL As String, dbConn As New ADODB.Connection
    Dim dblMinExt0 As Double, dblMaxExt0 As Double, dblMinExt1 As Double, dblMaxExt1 As Double
    Dim strDatei As String, intPos As Integer
    'On Error GoTo Fehler
   
    dbConn = "P0407"
    dbConn.Open
    intPos = InStr(ThisDrawing.Name, ".dwg")
   
    strDatei = Left(ThisDrawing.Name, intPos - 1)
    For Each Ent In ThisDrawing.ModelSpace
        If TypeOf Ent Is AecArea Then
            strHandle = Ent.Handle
            Ent.GetBoundingBox minExt, maxExt
            dblMinExt0 = minExt(0)
            dblMaxExt0 = maxExt(0)
            dblMinExt1 = minExt(1)
            dblMaxExt1 = maxExt(1)
           
            SQL = "delete from tblGE_RB_Koordinaten where Zeichnung = '" & strDatei & "' and Referenz = '" & strHandle & "'"
            dbConn.Execute SQL
           
            SQL = " insert into tblGE_RB_Koordinaten (Zeichnung, Referenz, MinExt0, MinExt1, MaxExt0, MaxExt1)  "
            SQL = SQL & " values ('" & strDatei & "',  '" & strHandle & "', " & SplitKomma(dblMinExt0) & ", " & SplitKomma(dblMaxExt0) & ", " & SplitKomma(dblMinExt1) & ", " & SplitKomma(dblMaxExt1) & ")"
            dbConn.Execute SQL
           
        End If
    Next Ent
    dbConn.Close
    Set dbConn = Nothing
    Exit Sub
Fehler:
    MsgBox "Fehler " & Err.Number & ":" & vbNewLine & _
        Err.Description, vbInformation + vbOKOnly, "Fehler"
End Sub

Function SplitKomma(Übergabewert As Double)
Dim arrWert, i, strTeilString As String
    arrWert = Split(Übergabewert, ",")
    For Each i In arrWert
        strTeilString = strTeilString & "." & i
    Next i
    strTeilString = Right(strTeilString, Len(strTeilString) - 1)
    SplitKomma = strTeilString

End Function

------------------

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP