---

Hi Forum,

mit

Code:

---

Public Function SelAllInsertByName(BLKName As String)
Dim All_E
Dim i As Integer
Dim Filter(3, 1) As Variant
Filter(0, 0) = -4
Filter(0, 1) = "<AND"
Filter(1, 0) = 0 'DXF-Gruppencode
Filter(1, 1) = "Insert" 'Blöcke
Filter(2, 0) = 2 'DXF-Gruppencode
Filter(2, 1) = BLKName 'Name
Filter(3, 0) = -4
Filter(3, 1) = "AND>"

All_E = Select_All_Filter("All", Filter)
SelAllInsertByName = All_E
End Function

---

erzeugte ich einen filter, der mir dann nur blöcke in mein selectionset einlas.
in adt2006 habe ich jetzt allerdings ein objekt namens IAecMVBlock.
bin gerade dabei, mich in vba für adt "hineinzukämpfen" und kann mit besagtem objekt noch nix anfangen. wie lautet denn dafür der DXF-GruppenCode?
Bernd

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

Bernd

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

---

gib mal (entget(car(entsel))'("*")) ein und klick so ein Objekt an .... dann bekommst du eine Liste mit den Gruppencodes und den Werten

------------------
  - Thomas -
"Bei 99% aller Probleme ist die umfassende Beschreibung des Problems bereits mehr als die Hälfte der Lösung desselben."

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

---

test.zip

heißen dank für die schnelle antwort, und danke für den sehr nützlichen codeschnipsel.

als antwort gekomme ich (nur auszugsweise)

Code:

---

(2 . "FLÄCHEN:AnrechenbareFläche") (70 . 0) (74 . 0) (173 . -1) (174 .
0) (343 . <Objektname: 0> ) (102 . "AEC_SUBOBJECT}") (102 . "{AEC_SUBOBJECT")
(300 . "AecMvBlockAttribute") (100 . "AecImpObj") (3 . "") (100 .
"AecMvBlockAttribute") (305 . "Basisumfang") (340 . <Objektname: 7ef73c80> )
(172 . 0) (341 . <Objektname: 7ef73ca0> ) (149 . 0.0) (10 0.0 -3.15 0.0) (40 .
0.4) (1 . "296.97 m") (50 . 0.0) (41 . 1.0) (51 . 0.0) (342 . <Objektname:
7ef79850> ) (71 . 0) (72 . 0) (11 0.0 0.0 0.0) (210 0.0 0.0 1.0) (73 . 0)

(2 . "FLÄCHEN:Basisumfang") (70 . 0) (74 . 0) (173 . -1) (174 . 0) (343 .
<Objektname: 0> ) (102 . "AEC_SUBOBJECT}") (102 . "{AEC_SUBOBJECT") (300 .
"AecMvBlockAttribute") (100 . "AecImpObj") (3 . "") (100 .
"AecMvBlockAttribute") (305 . "Beschreibung") (340 . <Objektname: 7ef73c80> )
(172 . 0) (341 . <Objektname: 7ef73ca0> ) (149 . 0.0) (10 0.0 -3.87 0.0) (40 .
0.4) (1 . "Test") (50 . 0.0) (41 . 1.0) (51 . 0.0) (342 . <Objektname:
7ef79850> ) (71 . 0) (72 . 0) (11 0.0 0.0 0.0) (210 0.0 0.0 1.0) (73 . 0)

---

der angegebene blockname hat immer noch den DXF-Code 2.
allerdings ist das nicht der blockname des objektes, das ich anklicke, sondern diese namen erscheinen erst, wenn ich das objekt mehrfach sprenge. der knackpunkt scheint mir hier zu liegen (102 . "AEC_SUBOBJECT}
was fange ich den damit an? subobjekte waren mir bisher unbekannt?
habe mal ne minizeichnung mit einem block angehängt. (adt2006 bzw acad2006)
bernd

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

Bernd

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

---

Abend Bernd,

der Stempel (MV-Block) ist mit der Fläche [Owner] verknüpft,
d.h. die eigentlichen Infos wie Umfang/Fläche etc. enthält die Fläche selbst und lässt sich von dieser aus auslesen:

Code:

---

Sub test()
    Dim sch As New AecScheduleApplication, propSets As AecSchedulePropertySets
    Dim schedData As AecSchedulePropertySet
    Dim o As AcadEntity, p, i%
    ThisDrawing.Utility.GetEntity o, p, "Object:"
    Set propSets = sch.PropertySets(o)
    Set schedData = propSets("Flächen")
    With schedData.Properties
        On Error Resume Next
        For i = 0 To .Count - 1
            Debug.Print .Item(i).Name, .Item(i).Value
        Next
    End With
End Sub

---

Ich glaube mit dem Stempel selber wird das schwieriger, wobei ich jetzt auch nicht genau weiss was du vorhast.

Naja und so der ADT-Held bin ich auch nicht, von VBA ganz zu schweigen, mir reicht das Dings manchmal so schon;-)
jedenfalls für deinen Forscherdrang hab' ich was: http://www.cadmin.com/VBA_for_ADT/Schedules.htm

matsch fan & welcome to the jungle;-)

Gruss Nancy

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

---

hi startrek,
so wirklich klar komme ich mit deinem code noch nicht.

With schedData.Properties verursacht den Fehler:
Laufzeitfehler 91:
Objektvariable oder with-blockvariable nicht festgelegt.

was ich letztendlich erreichen will, ist: die attribute wie nummer, fläche, bezeichnung etc auszulesen. oder muss ich da eventuell direkt an den owner gehen?
bernd

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

Bernd

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

---

Ja Bernd,

genau, der Code bezieht sich auf die Fläche selber, _nicht_ auf den Stempel.
Also --> die Area anklicken;-)

Bei mir gings, das on error brauchst für propertie-values, welche keine Daten enthalten, ansonsten noch Verweise checken, wobei da wäre der Fehler klar.

Wiegesagt, bei mir gings, hatte sogar deine test.dwg, muss aber dazusagen ADT2005 ..., aber ich hoffe daran soll's nicht liegen;-)

Gruss Nancy

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

---

hi nancy,
heißen dank für deinen link. der hilft mir EXTREM weiter. dafür Us soviel du willst...10 schonmal voab 
Bernd

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

Bernd

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

---

Hi Nancy,
nochmal vielen dank für deinen code, durch den ich mich mittlerweile durchgebissen habe. hab ihn ein bißchen erweitert und schreibe jetzt die gewünschten daten in ein array, das ich dann (in einem überarbeiteten code) auslesen werde. vielleicht mag mir ja mal jemand seine meinung dazu sagen.
bernd

Code:

---

Sub Ausl()
Dim AecDoc As AecDocument
Dim Zaehler1 As Long, Zaehler2 As Long, Zaehler3 As Long
Dim aecObj As AecGeo
Set AecDoc = AecArchBaseApplication.ActiveDocument
For Zaehler1 = 0 To AecDoc.ModelSpace.Count - 1
    If TypeName(AecDoc.ModelSpace.Item(Zaehler1)) = "IAecArea" Then
        Set aecObj = ThisDrawing.ModelSpace(Zaehler1)
        Dim SchedApp As AecScheduleApplication
        Dim propSets As AecSchedulePropertySets
        Dim propSet As AecSchedulePropertySet
        Dim props As AecScheduleProperties
        Set SchedApp = New AecScheduleApplication
        Set propSets = SchedApp.PropertySets(aecObj)
        Set propSet = propSets.Item(0)
        Set props = propSet.Properties
        Dim Data() As Variant
        ReDim Data(props.Count, 1)
        For Zaehler2 = 0 To props.Count - 1
            On Error Resume Next
            Data(Zaehler2, 1) = Null
            Data(Zaehler2, 1) = props(Zaehler2).Value
            Data(Zaehler2, 0) = props(Zaehler2).name
            Debug.Print props(Zaehler2).name, props(Zaehler2).Value
       
        Next Zaehler2
        Zaehler3 = Zaehler3 + 1
    End If
Next Zaehler1
Set AecDoc = Nothing
If Zaehler3 = 0 Then
    MsgBox "Es sind keine Flächen in dieser Zeichnung definiert." & vbCrLf & _
    "Die Funktion wird abgebrochen", vbOKOnly, "Keine definierten Flächen"
    Exit Sub
End If
Set SchedApp = Nothing
Set propSets = Nothing
Set propSet = Nothing
Set props = Nothing
End Sub

---

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

Bernd

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