---

Halle zusammen!
ich habe mir folgenden Code zusammenkopiert und probiert ein Formular mit den Werten des Zeichnungskopfes mit dem Namen SF_Nxx einzulesen. Mit den meisten Zeichnungen klappt das Problemlos. Es gibt aber Zeichnungen bei denen der Name SF_Nxx nicht gefunden wird, obwohl der Block in der Zeichnung vorhanden ist.

Kann mir da ein ACAD-VBA Guru helfen das Problem zu finden?

Code:

---

Private Sub userform_Initialize()

  Dim EntGrp(0) As Integer
  Dim EntPrp(0) As Variant
  Dim BlkObj As Object
  Dim Pt1(0) As Double
  Dim Pt2(0) As Double
  Dim x As Integer
 
  'define error function
  On Error GoTo Err_Control
 
    'create a selection set
    Set ssnew = ThisDrawing.SelectionSets.Add("TBLK")
       
    'Filter for Group code 2, the block name
    EntGrp(0) = 2
   
    'The name of the block to filter for
      Dim tAcadEnt As AcadEntity

      For Each tAcadEnt In ThisDrawing.ActiveLayout.Block
      If TypeOf tAcadEnt Is AcadBlockReference Then
      SF = UCase(tAcadEnt.Name)
            If InStr(SF, "SF_N") Then
                EntPrp(0) = tAcadEnt.Name    ' ergibt SF_Nxx
                SF = UCase(tAcadEnt.Name)
            End If
      End If
      Next

    'find the block
    ssnew.Select acSelectionSetAll, Pt1, Pt2, EntGrp, EntPrp
 
    'If a block is found
    If ssnew.Count >= 1 Then
     
    'Get the block's attributes
    Tatts = ssnew.Item(0).GetAttributes
   
    If InStr(SF, "SF_") Then
        Else
        MsgBox "Problem beim Erkennen des Schriftfeldes." & vbCr & "Bitte melde Zeichnungsnummer." & vbCr & "Zeichnung: " & ThisDrawing.GetVariable("dwgname") & vbCr & "Schriftfeld: " & SF, vbCritical, "Schriftfelderkennung..."
        Unload frmEditAttr
        Exit Sub
    End If
.
.
.

---

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

---

Hi,

vielleicht nicht alles, aber was ich jetzt mal sehe:

Bei einer Selektion mit Fensterangabe (Pt1 und Pt2) muss immer ein Array von 3 Doubles sein (XYZ) oder Du läßt die Fensterangaben gleich weg, wenn Du diese nicht brauchst:

Code:

---

ssnew.Select acSelectionSetAll, , , EntGrp, EntPrp

---

Weiters suchst Du zwar eine BlockReference in einem bestimmten Layout, danach machst Du eine Selektion, die aber durch die gesamte Zeichnung sucht. Da kann's schon passieren, dass Du dann die BlockReference(s) anderer Layouts bekommst.

Wenn Du schon die BlockReference (beim Suchen nach dem Namen) gefunden hast (und ich davon ausgehe, dass es nur einen Schriftkopf in einem Layout gibt, dann brauchst Du ja nachher nicht nochmals zu selektieren, oder?

Und wenn Du nach BlockReferences suchen willst, die 'SF_N' im Blocknamen haben, dann kannst Du das gleich im Selektionset mit WildChars definieren:

Code:

---

EntGrp(0) = 2
EntPrp(0) = "*SF_N*"
...
ssnew.Select acSelectionSetAll, , , EntGrp, EntPrp

---

Und damit jetzt noch alles richtig wird, musst Du noch wissen, dass mit DXFCode=2 mehr als nur BlockName gespeichert wird, also solltest Du auch nach Objekttyp filtern.

Code:

---

Dim EntGrp(1) as Integer
Dim EntPrp(1) as Variant
EntGrp(0) = 0
EntPrp(0) = "INSERT"
EntGrp(1) = 2
EntPrp(1) = "*SF_N*"
...
ssnew.Select acSelectionSetAll, , , EntGrp, EntPrp

---

- alfred -

------------------
www.hollaus.at

---

Hallo alfred
Super, besten Dank für die schnelle Antwort.
Ich hab den code nun wie unten angepasst und das hat das Problem bei den meisten Zeichnungen gelöst.

Eine Zeichnung mit sehr vielen Elementen hat das Problem jedoch noch.

Kann man den Layer auch in den Auswahlsatz einbeziehen, das Schriftfeld ist bei allen Zeichnungen immer auf dem gleichen Layer. (Gain_ZSF)

Bei Zeichnungen die recht gross sind, ca. 8MB, dauert es relativ lange bis die userform angezeigt wird. Ev. würde das auch beschleunigt wenn nur der spez. Layer durchsucht werden muss.

Besten Dank für Deine Hilfe!

Code:

---

Private Sub userform_Initialize()

Dim EntGrp(1) As Integer
Dim EntPrp(1) As Variant
EntGrp(0) = 0
EntPrp(0) = "INSERT"
EntGrp(1) = 2
EntPrp(1) = "*SF_N*"

  'define error function
  On Error GoTo Err_Control
 
  'create a selection set
  Set ssnew = ThisDrawing.SelectionSets.Add("TBLK")
       
  'Filter for Group code 2, the block name
  EntGrp(0) = 2
   
  'The name of the block to filter for
  Dim tAcadEnt As AcadEntity
   
  For Each tAcadEnt In ThisDrawing.ActiveLayout.Block
  If TypeOf tAcadEnt Is AcadBlockReference Then

    SF = UCase(tAcadEnt.Name)
      If InStr(SF, "SF_N") Then
      EntPrp(0) = tAcadEnt.Name    ' ergibt SF_Nxx
      SF = UCase(tAcadEnt.Name)
    End If
  End If
  Next
   
 
  ' find the block
  ssnew.Select acSelectionSetAll, , , EntGrp, EntPrp ' alfred
 
  'If a block is found
  If ssnew.Count >= 1 Then
     
  'Get the block's attributes
  Tatts = ssnew.Item(0).GetAttributes
   
  If InStr(SF, "SF_") Then
    Else
    MsgBox "Problem beim Erkennen des Schriftfeldes." & vbCr & "Bitte melden Sie die Zeichnungsnummer " & vbCr & "Zeichnung: " & ThisDrawing.GetVariable("dwgname") & vbCr & "Schriftfeld: " & SF, vbCritical, "Schriftfelderkennung..."
        Unload frmEditAttr
        Exit Sub
    End If
       
...

---

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

---

Hi,

nachdem 'wir' oben schon den Blocknamen für den Filter des SelectionSets gesetzt haben, brauchst Du die Schleife zum herausfinden des Blocknamens nicht mehr (zusaetzlich wird in der schleife auch EntPrp(0) gesetzt, was nach obiger Arraybefüllung eigentlich der Objekttyp ist).
Also die Schleife mit  For Each tAcadEnt In ThisDrawing.ActiveLayout.Block  raus.

Du solltest auch vorsichtig sein mit  Set ssnew = ThisDrawing.SelectionSets.Add("TBLK")  denn existiert das SelektionSet bereits, fliegst Du aus der Routine heraus.

Last but not least, was hat Deine Routine mit ActiveLayout zu tun. Es ist immer noch so, dass Du ein SelectionSet machst (welches Elemente der ganzen Zeichnung behandelt) und eine For-Next Schleife, die nur im aktiven Layout sucht. Mit dieser Antwort könnte sich der Code doch einigermassen ändern.

- alfred -

------------------
www.hollaus.at

---

Hi alfred
danke für die Info. Ich hab nun mein code abgespeckt, so dass ich verstehe was passiert. Mit dem folgenden code werden mir die Attributwerte ins Formular übertragen und mit UBound(Tatts) sehe ich dass es deren 19 an der Zahl sind.

Was ich jetzt noch herausfinden möchte, ist der komplette Name des *SF_N* Blockes, wie komme ich an den ran?

Code:

---

Private Sub userform_Initialize()

Dim EntGrp(1) As Integer
Dim EntPrp(1) As Variant
EntGrp(0) = 0
EntPrp(0) = "INSERT"
EntGrp(1) = 2
EntPrp(1) = "*SF_N*"

  'define error function
  ' On Error GoTo Err_Control
 
    'create a selection set
    Set ssnew = ThisDrawing.SelectionSets.Add("TBLK")
   
    ' find the block
    ssnew.Select acSelectionSetAll, , , EntGrp, EntPrp ' alfred
   
    'If a block is found
    If ssnew.Count >= 1 Then
      MsgBox ssnew.Count
    End If
         
    'Get the block's attributes
    Tatts = ssnew.Item(0).GetAttributes
   
    MsgBox UBound(Tatts)
   
        frmEditAttr.F4.Text = (LTrim(Tatts(0).TextString))
        frmEditAttr.F6.Text = (LTrim(Tatts(1).TextString))
        frmEditAttr.F7.Text = (LTrim(Tatts(2).TextString))
.
.
.

---

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

---

Hi,

>> Was ich jetzt noch herausfinden möchte, ist
>> der komplette Name des *SF_N* Blockes

Code:

---

ssnew.Item(0).Name

---

- alfred -

------------------
www.hollaus.at

---

hat geklappt, danke schön!

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