---

Hallo, wir haben folgendes Problem:

wir möchten im Fall einer Falscheingabe eines Wertes über die Schnelleigenschaften eines dynamischen Blockes (Typ5-2),
eine Meldung ausgeben (funktioniert), und anschließend wieder
automatisch den Block markieren und die Schnelleigenschaften
des Blockes anzeigen lassen.

Mit 1. 2. 3 s. unten haben wir schon einige Möglichkeiten ausprobiert
den dyn. Block zu markieren, allerdings ohne Erfolg.

Gibt es überhaupt eine Methode dies zu erreichen?

Vielen Dank

jkl

Code:

---

...Case Else
  MsgBox "SZR falsch - kein gültiger Wert für SZR 3 bzw SZR 4"
  Call Block_ansprechen_und_aktiv_setzen

...
Dim MyEnt As AcadEntity
Dim MyMText As AcadMText

    For Each bobj In ThisDrawing.ModelSpace
        If bobj.ObjectName = "AcDbBlockReference" Then
            If bobj.IsDynamicBlock Then
                If bobj.EffectiveName Like "Typ5-2" Then
                  '1. bobj.Visible = True
                  '2. bobj.Highlight True
                ' 3. ThisDrawing.SendCommand ("quickproperties" & Chr(13)) '  Chr(13)  = Return
                                     
           
                End If
            End If
           
        End If
    Next

End Sub

---

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

---

Markieren? Das geht doch generell nicht mit VBA oder sehe ich da was falsch?
Mit dynBlocks hätte die Anfrage dann nichts mehr zutun, es ist ein generelles Problem.

Falls ich mich nicht irre: Für das markieren mußt du auf eine Funktion aus einer anderen Sprache ausweichen, in deinem Fall würde eine Lispzeile via Sendcommand ausreichen.

Hier mal der Tip wir man mit Google das Forum durchsuchen kann, aber auch die interne Suchfunktion kann gern genutzt werden)

site:cad.de forum259 markieren

Technisch beschränkt es zwar nicht auf das Forum, aber die Treffer sind zu 99% daraus

------------------
CAD on demand GmbH - Beratung und Programmierung rund um AutoCAD

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

---

Hi doch das markieren geht geht aber das ist etwas hakelig.
http://ww3.cad.de/foren/ubb/Forum259/HTML/002111.shtml#000006

Ich geb zu der code ist noch arg suboptimal. (Aus der Rubrik da wollt Thomas noch mal weiterstriocken)

Unter 64 bit muss noch etwas angepasst werden, ESC kann man nicht mehr über sendcommand schicken. :/ Application.update macht mitunter auch probleme.

Sub selection_set_activate_by_xdata(ByVal selectionset As AcadSelectionSet)

'to set the entitys active you has first usually to use the
'selectionset.select function
'otherwise the selectionset can not be activated

'ensure nothing is selectef
    Application.UPDATE

    '    If SLOPEFORM.CURRENTGROUP.value = "" Then Exit Sub
    Dim GROUP As AcadGroup
    Dim Entity As AcadEntity
    Dim HANDLE As Long

    Dim xDataType() As Integer
    Dim xDataValue() As Variant

    ReDim xDataType(1)
    ReDim xDataValue(1)
    Dim XAPPNAME As String

    'kill the last selection first
    selection_previous_delete

    'mark all entitys inside selectionset with a temporary xdata mark

    XAPPNAME = "SEL"
    xDataType(0) = 1001
    xDataValue(0) = XAPPNAME
    xDataType(1) = 1000
    xDataValue(1) = "1"

    For Each Entity In selectionset
        Entity.SetXData xDataType, xDataValue
    Next
    Dim state As Object

    'ensure acad is bored

    Set state = GetAcadState
    Do Until state.IsQuiescent
        DoEvents
        Set state = GetAcadState
    Loop

    'use a lisp function to select the desired xdata marked elements,
    'cmd1 should be also possible with plain VBA just got the filter not created

    CMD1 = Chr(27) & Chr(27) & "(setq #filter (ssget " & Chr(34) & "x" & Chr(34) & "'((-3 (" & Chr(34) & XAPPNAME & Chr(34) & ")))))" & vbCr
    'activate last selectionset from cmd1
    CMD2 = (Chr(27) & Chr(27) & "_PSELECT" & vbLf & "_P" & vbLf & vbCr)

s = CMD1 & CMD2
s = Replace(s, Chr(27), "")
On Error Resume Next
ThisDrawing.SendCommand s

    'remove temporary xdata
    ReDim Preserve xDataType(0)
    ReDim Preserve xDataValue(0)

    For Each Entity In selectionset
        Entity.SetXData xDataType, xDataValue

    Next

End Sub

Sub select_block_similar()
    Dim Entity As AcadEntity
    Dim blockref As AcadBlockReference
    Dim bpname As String

    Application.UPDATE
    Selection_set_delete_all

    Dim selectionset As AcadSelectionSet
    Dim SSNAME As String
    SSNAME = bpname & time()
    Set selectionset = Selection_set_create(SSNAME)
    bpname = "Betonschwelle"
    For Each Entity In ThisDrawing.modelspace
        If LCase(Entity.ObjectName) = "acdbblockreference" Then
            Set blockref = Entity
            If InStr(blockref.EffectiveName, bpname) > 0 Then
                Call selectionset_add_entity(selectionset, Entity)

            End If
        End If
    Next

    Call selection_set_activate_by_xdata(selectionset)
End Sub

------------------
Wer es nicht versucht, hat schon verlorn 
Und bei 3 Typos gibts den vierten gratis !
<<< for sale !

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