---

Hallo,
ich such einen code mit dem ich ein zusatattribut 'messcode' finden kann .

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

---

Hallo "QS",

du hast dein Problem nicht sehr ausführlich beschrieben.

Willst du ein Blockattribut auslesen ?

Das geht z.B. so:

Code:

---

                  If obj_ACAD_Entity.EntityType = acBlock Then
                    TxPkt = obj_ACAD_Entity.InsertionPoint
                    layer = obj_ACAD_Entity.layer
                    Handle = obj_ACAD_Entity.Handle
                    Blockname = obj_ACAD_Entity.Name
                    Farbe = obj_ACAD_Entity.Color
                    Richtung = obj_ACAD_Entity.Rotation
                    Groesse = obj_ACAD_Entity.YScaleFactor
                    pnr = ""
                    If chk_PNR.value = 1 Then
                      If obj_ACAD_Entity.HasAttributes = True Then
                          Dim Block_attribute As Variant
                          Dim PNR_attribut As Object
                          Dim A%
                          Block_attribute = obj_ACAD_Entity.GetAttributes
                          For A = LBound(Block_attribute) To UBound(Block_attribute)
                              Set PNR_attribut = Block_attribute(A)
                              If UCase(PNR_attribut.TagString) = UCase("PNR") Then
                                pnr = PNR_attribut.TextString
                                Exit For
                              End If
                          Next A
                      End If
                    End If
                  end if

---

     
Du bildest entweder ein Selectionset oder durchläufst die
Modelspace Collection.
Für jedes Entity Block kannst du wie oben die Infos auslesen. Ist dein Problem gelöst ?

Gruß
Stelli1         

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

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

---

Danke, genau so einen Denkansatz habe ich benötigt.

Ich bin Vermessungstechniker, da braucht man das zusatzattribut 'Messcode'. Der Messcode ist ein zusatz den wir in unsere Tachy(vermessungsgerät) eingeben können um zusätzliche informationen einzugeben.
Für alle anderen Vermesser die so was mal brauchen werden (ist noch nicht fertig,aber es veranschaulicht ausreichend):

Code:

---

------------------------
Dim AcMapEntity As AcadEntity
Dim AcMapBlock As AcadBlockReference
Dim messkoo(0 To 1) As Punkt
Dim i
i = 0
For Each AcMapEntity In ThisDrawing.ModelSpace
    If AcMapEntity.ObjectName = "AcDbBlockReference" Then
        Set AcMapBlock = AcMapEntity
        If AcMapBlock.HasAttributes = True Then
           
            messkoo(i).PunktNummer = AcMapBlock.ObjectID
            messkoo(i).PunktX = Round(AcMapBlock.insertionPoint(0), 3)
            messkoo(i).PunktY = Round(AcMapBlock.insertionPoint(1), 3)
            messkoo(i).PunktZ = Round(AcMapBlock.insertionPoint(2), 3)
            MsgBox messkoo(i).PunktX & " ;" & messkoo(i).PunktY & " ;" & messkoo(i).PunktZ
            Dim Block_attribute As Variant
            Block_attribute = AcMapBlock.GetAttributes
            Dim PNR_attribut As Object
            Dim A As Integer, pnr
            For A = LBound(Block_attribute) To UBound(Block_attribute)
                              Set PNR_attribut = Block_attribute(A)
                              If PNR_attribut.TagString = "Messcode" Then
                                pnr = PNR_attribut.TextString
                                messkoo(i).PunktCode = pnr
                                MsgBox "lese" & A & "  " & pnr
                               
                                i = i + 1
                                ReDim messcoo(0 To i)
                                Exit For
                              End If
            Next A
            End If
            'messkoo.PunktX = Round((AcMapBlock.Rotation * 180 / Pi), 2)
    End If

---

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

---

Hallo QS,

schön das es weiter geholfen hat.

als Vermesser solltest du aber auch einen Genauigkeitscode
speichern.
Digitalisiert, einfach gemessen, gesichert etc.

Gruß
Stelli1

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

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

---

Hallo QS,

Zitat:

---

Original erstellt von QS:
...
ReDim messcoo(0 To i)
...

---

Gibts hier einen Schreibfehler in der Variablen ?
Wenns wie in der DIM Anweisung "MessKoo" sein soll
mußt du "Redim Preserve MessKoo" verwenden.
Sonst sind die ersten Punkte weg. Wäre schade drum.

Stelli1

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

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

---

stimmt hatte ich vergessen als ich den code reingestellt habe.
In dem messcode den ich verarbeite ist keine genauigkeit drinn, sonder ein Baumcode, den wir im aussendienst eingeben. Der Code beinhaltet dann die Baumart, den umfang des stammes, die entfernung von stamm zur weitesten astentfernung in jeder himmelsrichtung, und die Höhe. PS:leider ist das mein erstes VBA Programm seit 2 Jahren VB Pause. Somit kommen leider andauernd fehler vor.
Servus

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