Viewport - fenetre dans espace papier de type polyligne

[tyrese69_]

Bonjour à tous,

 

Losque l'on sélectionne une viewport (fenêtre) de type polyligne, c'est toujour l'objet "polyligne" qui est retourné ! Comment obtenir la fenêtre associée ?

 

La même question pourrait être faite pour les objets sélectionnés de type ellipse, cercle, spline ou nuage (idem polyligne)

 

Dans l'exemple ci-aprés, la sélection se fait par les caractéristiques des objets ! :

 

Daniel OLIVES

 

'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

'* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - *

'* 04 - Test les fenêtre afin d'afficer les couches gelées *

'* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - *

'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

Sub TestVpLayerX()

Dim strLayer As String

Dim objAcad As AcadObject

Dim Pt1 As Variant

Dim strPrompt As String

'

Dim bValtrouv As Boolean

Dim myLayout As AcadLayout

Dim myPViewport As IAcadPViewport

Dim PtCenterEll As Variant

Dim PtCenterPV As Variant

Dim PtCenterPLW(0 To 2) As Double

Dim region_element(0) As AcadEntity

Dim region As Variant

Dim reg As AcadRegion

Dim centroid As Variant

Dim returnPnt(0 To 2) As Double

Dim MinPTBx As Variant

Dim MaxPTBx As Variant

Dim MilieuxPTBx(0 To 2) As Double

Dim AreaSpline As Variant

Dim AreaRegion As Variant

 

On Error GoTo err_selectVPobjectsToFreeze

 

' set an undo mark in the drawing

ThisDrawing.StartUndoMark

 

If ThisDrawing.ActiveSpace = acModelSpace Then

' Passe en espace papier

ThisDrawing.ActiveSpace = acPaperSpace

' Non flottant

ThisDrawing.Mspace = False

'MsgBox "This program only works with PaperSpace Viewports" & vbCr & _

' "Please go to PaperSpace", vbCritical

'Exit Sub

End If

' let's get into Paper Space

' ThisDrawing.Mspace = False

 

'*************************

' VIEWPORT

'**********

ThisDrawing.Utility.GetEntity objAcad, Pt1, "Sélectionner une fenêtre (ViewPort) :"

bValtrouv = False

If TypeOf objAcad Is AcadPViewport Then

Set myPViewport = objAcad

bValtrouv = True

mess = "Vous avez sélectionné une fenêtre type ""PViewport"" !" & vbCrLf & vbCrLf

End If

'*************************

' SPLINE

'********

If TypeOf objAcad Is IAcadSpline Then

' - - - - - - - - - - - - - - - - - - - - - - - - - -

' Création de la région

'------------------------

Set region_element(0) = objAcad

region = ThisDrawing.ModelSpace.AddRegion(region_element)

Set reg = region(0)

' Le point de base du texte est le centre de la region

centroid = reg.centroid

PtCenterPLW(0) = centroid(0): PtCenterPLW(1) = centroid(1): PtCenterPLW(2) = 0

' - - - - - - - - - - - - - - - - - - - - - - - - - -

mess = "Vous avez sélectionné une fenêtre type ""SPLINE"" !" & vbCrLf & vbCrLf

For Each objAcad In ThisDrawing.PaperSpace

If TypeOf objAcad Is IAcadPViewport Then

Set myPViewport = objAcad

PtCenterPV = myPViewport.center

' Attention différences selon précision !

If myPViewport.Clipped = True And (Abs(PtCenterPLW(0) - PtCenterPV(0)) < (1 * (PtCenterPV(0) / 100)) And _

Abs(PtCenterPLW(1) - PtCenterPV(1)) < (1 * (PtCenterPV(1) / 100)) And PtCenterPLW(2) = PtCenterPV(2)) Then

' MsgBox "Fenêtre récupérée !"

bValtrouv = True

Exit For

End If

End If

Next

End If

'*************************

' CERCLE

'********

If TypeOf objAcad Is IAcadCircle Then

PtCenterEll = objAcad.center

mess = "Vous avez sélectionné une fenêtre type ""Cercle"" !" & vbCrLf & vbCrLf

For Each objAcad In ThisDrawing.PaperSpace

If TypeOf objAcad Is IAcadPViewport Then

Set myPViewport = objAcad

PtCenterPV = myPViewport.center

' Attention différences selon précision ! Faire essai avec % de valeur

If myPViewport.Clipped = True And ((PtCenterEll(0) - PtCenterPV(0)) < (0.1 * (PtCenterPV(0) / 100)) And _

(PtCenterEll(1) - PtCenterPV(1)) < (0.1 * (PtCenterPV(1) / 100)) And PtCenterEll(2) = PtCenterPV(2)) Then

' MsgBox "Fenêtre récupérée !"

bValtrouv = True

Exit For

End If

End If

Next

End If

'*************************

' ELLIPSE

'*********

If TypeOf objAcad Is IAcadEllipse Then

PtCenterEll = objAcad.center

mess = "Vous avez sélectionné une fenêtre type ""Ellipse"" !" & vbCrLf & vbCrLf

For Each objAcad In ThisDrawing.PaperSpace

If TypeOf objAcad Is IAcadPViewport Then

Set myPViewport = objAcad

PtCenterPV = myPViewport.center

If myPViewport.Clipped = True And (PtCenterEll(0) = PtCenterPV(0) And _

PtCenterEll(1) = PtCenterPV(1) And PtCenterEll(2) = PtCenterPV(2)) Then

' MsgBox "Fenêtre récupérée !"

bValtrouv = True

Exit For

End If

End If

Next

End If

'*************************

' POLYLIGNE ou NUAGE

'********************

If TypeOf objAcad Is AcadLWPolyline Then

objAcad.GetBoundingBox MinPTBx, MaxPTBx

MilieuxPTBx(0) = (MaxPTBx(0) + MinPTBx(0)) / 2

MilieuxPTBx(1) = (MaxPTBx(1) + MinPTBx(1)) / 2

MilieuxPTBx(2) = 0

mess = "Vous avez sélectionné une fenêtre type ""Polyligne"" !" & vbCrLf & vbCrLf

' - - - - - - - - - - - - - - - - - - - - - - - - - - - -

For Each objAcad In ThisDrawing.PaperSpace

If TypeOf objAcad Is IAcadPViewport Then

Set myPViewport = objAcad

PtCenterPV = objAcad.center

If myPViewport.Clipped = True And (MilieuxPTBx(0) = PtCenterPV(0) And _

MilieuxPTBx(1) = PtCenterPV(1) And MilieuxPTBx(2) = PtCenterPV(2)) Then

' MsgBox "Fenêtre récupérée !"

bValtrouv = True

Exit For

End If

End If

Next

End If

 

If bValtrouv = True Then

VpLayerAffListOff myPViewport

' Place an end to the undo mark

ThisDrawing.EndUndoMark

End If

' exit this sub

Exit Sub

 

' error handling

err_selectVPobjectsToFreeze:

MsgBox Err.Description, vbInformation

Err.Clear

ThisDrawing.EndUndoMark

 

End Sub

'

[tyrese69_]

La suite :

 

'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

'* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - *

'* 05 - Affichage des couches gelées *

'* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - *

'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

'

Sub VpLayerAffListOff(objPViewport As AcadPViewport)

Dim xdataType As Variant

Dim xdataValue As Variant

Dim newXdataType As Variant

Dim newXdataValue As Variant

Dim i As Integer

Dim counter As Integer

Dim Pt1 As Variant

Dim varCenter As Variant

Dim dblWidth As Double

Dim dblHeight As Double

Dim objViewPortNew As AcadPViewport

 

' Get the Xdata from the Viewport

objPViewport.GetXData "ACAD", xdataType, xdataValue

 

For i = LBound(xdataType) To UBound(xdataType)

' Look for frozen Layers in this viewport

If xdataType(i) = 1003 Then

' Set the counter AFTER the position of the Layer frozen layer(s)

counter = i + 1

mess = mess & xdataValue(i) & vbCrLf

' Match the layer we are looking for and exit the sub --

' bingo we have the frozen layer location!

End If

Next

 

' Layer not found in this Mview

If counter = 0 Then

MsgBox "Pas de couches gelées", vbInformation, "Technip TPS - PViewport Xdata - Liste des Layer Off"

Exit Sub

End If

MsgBox mess, vbInformation, "Technip TPS - PViewport Xdata - Liste des Layer Off"

 

End Sub

'

[(gile)]

Salut,

 

Avec COM/ActiveX (VBA ou Visual LISP), je n'ai jamais trouvé.

Par contre en AutoLISP avec les données DXF, c'est assez facile, il s'agit du groupe 330 entre les "balises" :

(102 . "{ACAD_REACTORS") et (102 . "}")

 

(defun GetViewport (/ vp elst)
 (if
   (and
     (setq vp (car (entsel "\nSélectionnez une fenêtre: ")))
     (or (= (cdr (assoc 0 (setq elst (entget vp)))) "VIEWPORT") ;_ l'objet sélectionné est une fenêtre
         (and (setq vp (cdr (assoc 330 (member '(102 . "{ACAD_REACTORS") elst)))) ;_ l'objet sélectionné a un groupe 330
              (= "VIEWPORT" (cdr (assoc 0 (entget vp)))) ; qui est bien une fenêtre
         )
     )
   )
    vp
 )
)

 

Une autre solution serait de faire une sélection filtrée :

(ssget "_:E:S" '((0 . "VIEWPORT")))

Je te laisse traduire en VBA, mais je suis pas sûr qu'il y ait l'équivalent de "_:E:S" pour : sélection unique de tout ce qui se trouve sous le curseur.

[tyrese69_]

Bonjour Gile

J'ai un petit PB ave ton code, le if est toufour faux

 

Dans le And j'ai bien (= "VIEWPORT" (cdr (assoc 0 (entget vp)))) = T

 

Mais pour : (setq vp (cdr (assoc 330 (member '(102 . "{ACAD_REACTORS") elst)))) = <Nom d'entité: 7ed8ca98>

 

Par contre (= (cdr (assoc 0 (setq elst (entget vp)))) "VIEWPORT") = T

 

Donc le Or devrait donner

 

(J'ai un peut de mal avec le LISP !)

 

(defun c:GetV (/ vp elst)

(setq vp (car (entsel "\nSélectionnez une fenêtre: ")))

(if (or (= (cdr (assoc 0 (setq elst (entget vp)))) "VIEWPORT") ;_ l'objet sélectionné est une fenêtre

(and (setq vp (cdr (assoc 330 (member '(102 . "{ACAD_REACTORS") elst)))) ;_ l'objet sélectionné a un groupe 330

(= "VIEWPORT" (cdr (assoc 0 (entget vp)))) ; qui est bien une fenêtre

)

)

vp

)

)

 

Quelle est la différence car ici dans !vp j'ai bien <Nom d'entité: 7ed8ca98>

 

Daniel OLIVES

[tyrese69_]

Re Bonjour Gile je crois que mon problème vient du fait que je sélectionne une fenêtre polyligne !

[tyrese69_]

Re bonjour,

J'ai enfin compris !

 

(defun c:GetVP (/ vp elst)

(setq vp (car (entsel "\nSélectionnez une fenêtre simple ou de type polyLigne: ")))

(if (= (cdr (assoc 0 (setq elst (entget vp)))) "VIEWPORT") ;_ l'objet sélectionné est une fenêtre

(setq ValVP vp)

)

(if (and (setq vpPol (cdr (assoc 330 (member '(102 . "{ACAD_REACTORS") elst)))) ;_ l'objet sélectionné a un groupe 330 <Nom d'entité: 7ed8ca98> Cas d'une polyLigne

(= "VIEWPORT" (cdr (assoc 0 (entget vpPol))))) ; qui est bien une fenêtre

(setq ValVP vpPol)

)

ValVP

)

 

Dans ValVP j'ai bien soit l'une soit l'autre selon le fenêtre choisie !

 

Daniel OLIVES

[tyrese69_]

Re ,

 

Au fait si je souhaite avoir la valeur texte de :

 

<Nom d'entité: 7ed8ca98>

 

Comment doit je procéder (pour afficher la valeur pour essais !)

 

Daniel OLIVES

 

Merci encore à toi (Gile)

[Patrick_35]

Salut

 

Tu souhaites connaitre l'ObjectId de la fenêtre pour être en cohérence avec ce message ?

 

(vla-get-objectid (vlax-ename->vla-object ValVP))

 

ps : je pense comprendre que tu souhaites ressortir toutes les valeurs forcées dans chaque fenêtre (calque gelé, couleur autre, etc...) ?

 

@+

[(gile)]

Salut,

 

Le code que j'ai donné fonctionne.

Il est similaire à ce que tu fais mais en plus concis mais peut être moins lisible quand on a pas l'habitude des imbrications multiples d'expressions.

 

Rappel : en LISP les fonctions qui utilisent un prédicat (if, cond and, or, etc.) n'attendent pas nécessairement T ou nil (True ou False dans des langages plus fortement typés)) comme valeur de retour de l'expression prédicat mais simplement une valeur non nil ou nil. Autrement dit, toute valeur non nil est considérée comme vraie (True).

 

Si on décortique le code :

 

(defun GetViewport (/ vp elst)
 (if
   (and
     (setq vp (car (entsel "\nSélectionnez une fenêtre: ")))
     (or (= (cdr (assoc 0 (setq elst (entget vp)))) "VIEWPORT") ;_ l'objet sélectionné est une fenêtre
         (and (setq vp (cdr (assoc 330 (member '(102 . "{ACAD_REACTORS") elst)))) ;_ l'objet sélectionné a un groupe 330
              (= "VIEWPORT" (cdr (assoc 0 (entget vp)))) ; qui est bien une fenêtre
         )
     )
   )
    vp
 )

 

(if ... retournera la valeur de vp si l'expression ne retourne pas nil.

(and ... retournera T si les deux expressions qui lui sont passées retournent une valeur non nil :

      (setq vp (car (entsel "\nSélectionnez une fenêtre: ")))

et

      (or (= (cdr (assoc 0 (setq elst (entget vp)))) "VIEWPORT") ;_ l'objet sélectionné est une fenêtre
         (and (setq vp (cdr (assoc 330 (member '(102 . "{ACAD_REACTORS") elst)))) ;_ l'objet sélectionné a un groupe 330
              (= "VIEWPORT" (cdr (assoc 0 (entget vp)))) ; qui est bien une fenêtre
         )
     )

La première retournera nil si l'utilisateur ne sélectionne pas d'entité et l'expression (and ... retourne nil sans évaluer la seconde expression et (if ... retourne aussi nil, la routine retourne nil.

Si l'utilisateur sélectionne bien une entité, l'expression retourne le nom d'entité (non nil) qui est affecté à la variable vp et la seconde expression est évaluée.

 

(or ... retourne T dès qu'une expression qui lui est passée en argument retourne une valeur non nil.

(= (cdr (assoc 0 (setq elst (entget vp)))) "VIEWPORT")

Si l'entité sélectionnée est bien du type VIEWPORT, (or ... retourne T => (and ... retourne T => (if ... évalue vp et la routine retourne la valeur de vp (le nom d'entité de la fenêtre.

Si l'expression retourne nil (l'entité n'est pas de type VIEWPORT), la seconde expression est évaluée (au passage la variable elst a été initialisée avec la liste dxf de l'entité sélectionnée) :

          (and (setq vp (cdr (assoc 330 (member '(102 . "{ACAD_REACTORS") elst)))) ;_ l'objet sélectionné a un groupe 330
              (= "VIEWPORT" (cdr (assoc 0 (entget vp)))) ; qui est bien une fenêtre
         )

Encore une expression (and ... qui évalue deux expressions. La première affecte le nom d'entité de la fenêtre flottante à la variable vp si l'entité sélectionnée définit bien une fenêtre, dans ce cas la seconde expression vérifie que cette valeur est bien du type VIEWPORT.

Si c'est la cas (and ... retourne T => (or ... retourne T => (and ... retourne T => (if ... retourne T la routine retourne la valeur de vp.

Si une de ces deux expression retourne nil, (and ... retourne nil => (or ... retourne nil etc.