acces entité dans un bloc

[kisscool73]

salut et bonne année 2007

je debute en vba et deja bloqué

je voudrais changer de calque un type d'entité parmis d'autre qui sont dans

un block a partir d'une selection a l'ecran

-mon probleme c'est que je n'arrive pas a acceder aux objet qui sont dans mon bloc

ligne,cercle,...

 

Sub CommandButton1_Click()

Dim gui As AcadEntity

Dim guiBlock As AcadBlockReference

Dim gui2 As AcadEntity

On Error Resume Next

ThisDrawing.SelectionSets("SelectionConv").Delete

Set Sset = ThisDrawing.SelectionSets.Add("SelectionConv")

Sset.SelectOnScreen

For Each gui In Sset

If gui.ObjectName = "AcDbBlockReference" Then

For Each gui2 In gui

If gui2.ObjectName = "AcDbLine" Then

gui2.Layer = "NEW CALQUE"

End If

Next

End If

Next

End Sub

 

 

[Patrick_35]

Salut

 

Extrait de l'aide

 

Sub Example_GetSubEntity()

' This example prompts the user to select on object on the screen with a mouse click,

' and returns some information about the selected object.

 

Dim Object As Object

Dim PickedPoint As Variant, TransMatrix As Variant, ContextData As Variant

Dim HasContextData As String

 

On Error GoTo NOT_ENTITY

 

TRYAGAIN:

 

MsgBox "Use the mouse to click on an object in the current drawing after dismissing this dialog box."

 

' Get information about selected object

ThisDrawing.Utility.GetSubEntity Object, PickedPoint, TransMatrix, ContextData

 

' Process and display selected object properties

HasContextData = IIf(VarType(ContextData) = vbEmpty, " does not ", " does ")

 

MsgBox "The object you chose was an: " & TypeName(Object) & vbCrLf & _

"Your point of selection was: " & PickedPoint(0) & ", " & _

PickedPoint(1) & ", " & _

PickedPoint(2) & vbCrLf & _

"This object" & HasContextData & "have nested objects."

 

Exit Sub

 

NOT_ENTITY:

' If you click on empty space or do not select an entity,

' this error will be generated

If MsgBox("You have not selected an object. Click OK to try again.", _

vbOKCancel & vbInformation) = vbOK Then

Resume TRYAGAIN

End If

End Sub

 

@+

[kisscool73]

merci ca m'aide un peu

mais ca marche pas

ce que je voudrais c'est lister toutes les entitées d'un bloc

en le selectionnant puis changer de calque tel ou tel type d'entitée

 

[Patrick_35]

Salut

Je peux te pondre un lisp/vlisp pour ça mais pas un vba ;)

Regarde du cote de la table AcadBlocks. En la parcourant, tu retrouveras les entités qui composent un bloc

 

@+

[kisscool73]

je ne connait pas le lisp/vlisp

mais balance qu'en meme

je jetterai un coup d'oeil

[Patrick_35]

Voila, voila

 

(setq bls (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))) ; Je pointe sur la table des blocs
(setq bl (vla-item bls "Un_bloc")) ; Je pointe sur le bloc "Un_bloc" de la table
(vlax-for ent bl ; je parcours les entités qui composent le bloc
 (vlax-dump-object ent) ; j'affiche les caractéristiques des entitée
)
(vla-get-count bl) ; histoire de donner le nombre d'entités qui composent le bloc

 

@+

[winfield]

Bonne année !

Merci Patrick_35 .........je dis ça comme ça mais bon.....

[azrael]

salut kisscool73,

 

As-tu trouvé une solution en VB ?

 

Moi auss jecherche justement un moyen de remettre certains blocs en Bylayer (à l'origine) afin d'éviter de me trouver avec des layeurs qui n'existent que dans les blocs.

 

Bon courage !

[kisscool73]

Voila la solution que j'ai trouvè

 

Sub calques()

ThisDrawing.SelectionSets("Selection1").Delete

Set Sset = ThisDrawing.SelectionSets.Add("Selection1")

Sset.SelectOnScreen

Dim gui As AcadEntity

Dim guiBlock As AcadBlock

Dim guiname As String

Dim gui2 As AcadEntity

For Each gui In Sset

If gui.ObjectName = "AcDbBlockReference" Then

guiname = gui.Name

Set guiBlock = ThisDrawing.Blocks(guiname)

For Each gui2 In guiBlock

'dans cette selection je ne prend que les lignes

If gui2.ObjectName = "AcDbLine" Then

gui2.Layer = ListBox1.Value

'ou gui2.Layer= ce qu'on veut

End If

Next

End If

Next

 

voila j'esper que ca pourras t'aider

et si qq1 a une autre methode?

bienvenu

End Sub

[sechanbask]

Voir le lisp de (gile) edit_bloc... ça marche du tonnerre surtout la version 3.0. Je m'en sers pour nettoyer les plan lourds...