Créer une info-bulle lors d'un survol d'entité

[l56]

Bonjour,

Est-il possible en LISP/VLISP (via les réacteurs je suppose) de créer une commande qui afficherait une fenêtre (type info-bulle) quand la souris passe sur un bloc avec attribut ?

Par exemple, en appuyant sur CTRL et l'info-bulle apparaitrait avec les attributs que j'aurai choisi d'afficher. cela serait plus léger que d'afficher la boite de dialogue d'édition des attributs.

Autres exemple, je pourrais aussi l'utiliser pour afficher des X-datas d'entités qui en contiennent.

J'ai bien jeté un œil à "vlr-mouse-reactor" mais je ne sais pas quoi en faire ...

Merci à ceux qui ont une idée

L56

[fabcad]

Bonsoir,

Je pense que ces routines peuvent répondre à tes besoins.

Fabcad

Le Rennais Métropolitain

info.lsp readobjectdata-v2.lsp

[l56]

Merci FABCAD,

Ça à bien l'air d’être ça.

Mais il y a une routine qu'il ne trouve pas -> ade_odgettables

Il ne manquerai pas un fichier ?

 

[fabcad]

Bonsoir,

ade_odgettables fonctionne uniquement sous AutoCAD MAP (c'est juste pour voir si tu peux l'adapter avec les Xdatas).

Fabcad

Le Rennais Métropolitain

[l56]

Bonjour,

Très bien, je vais creuser un peu plus.

Merci encore pour cette échange.

L56

[bonuscad]

Bonjour,

Pour les XData il y a ce fil de discussion

Je remet le code qui a légèrement changé car des utilisateurs ont rencontré des dysfonctionnement lors de l'utilisation dans des SCU.

(vl-load-com)
(defun c:dyn_read_xdata ( / AcDoc Space UCS save_ucs WCS nw_obj ent_text dxf_ent apps lst_apps data ncol strcatlst Input obj_sel ename)
  (setq
    AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
    Space
    (if (= 1 (getvar "CVPORT"))
      (vla-get-PaperSpace AcDoc)
      (vla-get-ModelSpace AcDoc)
    )
    UCS (vla-get-UserCoordinateSystems AcDoc)
    save_ucs
    (vla-add UCS
      (vlax-3d-point '(0.0 0.0 0.0))
      (vlax-3d-point (getvar "UCSXDIR"))
      (vlax-3d-point (getvar "UCSYDIR"))
      "CURRENT_UCS"
    )
  )
  (vla-put-Origin save_ucs (vlax-3d-point (getvar "UCSORG")))
  (setq WCS (vla-add UCS (vlax-3d-Point '(0.0 0.0 0.0)) (vlax-3d-Point '(1.0 0.0 0.0)) (vlax-3d-Point '(0.0 1.0 0.0)) "TEMP_WCS"))
  (vla-put-activeUCS AcDoc WCS)
  (setq
    nw_obj
    (vla-addMtext Space
      (vlax-3d-point (trans (getvar "VIEWCTR") 1 0))
      0.0
      ""
    )
  )
  (mapcar
    '(lambda (pr val)
      (vlax-put nw_obj pr val)
    )
    (list 'AttachmentPoint 'Height 'DrawingDirection 'StyleName 'Layer 'Rotation 'BackgroundFill 'Color)
    (list 1 (/ (getvar "VIEWSIZE") 100.0) 5 (getvar "TEXTSTYLE") (getvar "CLAYER") 0.0 -1 176)
  )
  (setq
    ent_text (entlast)
    dxf_ent (entget ent_text)
    dxf_ent (subst (cons 90 1) (assoc 90 dxf_ent) dxf_ent)
    dxf_ent (subst (cons 63 254) (assoc 63 dxf_ent) dxf_ent)
  )
  (entmod dxf_ent)
  (while (and (setq Input (grread T 4 2)) (= (car Input) 5))
    (cond
      ((setq obj_sel (nentselp (cadr Input)))
        (if (eq (type (car (last obj_sel))) 'ENAME)
          (if (member (cdr (assoc 0 (entget (car (last obj_sel))))) '("INSERT" "ACAD_TABLE" "DIMENSION"))
            (if
              (or
                (eq (cdr (assoc 0 (entget (car (last obj_sel))))) "ACAD_TABLE")
                (not (eq (boole 1 (cdr (assoc 70 (tblsearch "BLOCK" (cdr (assoc 2 (entget (car (last obj_sel)))))))) 4) 4))
              )
              (setq obj_sel (cons (car (last obj_sel)) '((0.0 0.0 0.0))))
            )
          )
        )
        (setq
          dxf_ent (entget (car obj_sel) (list "*"))
        )
        (if (eq (cdr (assoc 0 dxf_ent)) "VERTEX")
          (progn
            (while (eq (cdr (assoc 0 dxf_ent)) "VERTEX")
              (setq dxf_ent (entget (entnext (cdar dxf_ent))))
            )
            (setq dxf_ent (entget (cdr (assoc -2 dxf_ent)) (list "*")))
          )
        )
        (if (eq (cdr (assoc 0 dxf_ent)) "ATTRIB")
          (setq dxf_ent (entget (cdr (assoc 330 dxf_ent)) (list "*")))
        )
        (setq
          apps (cdr (assoc -3 dxf_ent))
          ncol 0
          lst_apps nil
        )
        (if apps
          (foreach el apps
            (if (not (member (car el) lst_apps)) (setq lst_apps (cons (car el) lst_apps)))
          )
        )
        (if lst_apps
          (foreach xd lst_apps
            (setq
              data (assoc xd apps)
              strcatlst
              (strcat
                (if strcatlst strcatlst "")
                (apply 'strcat
                  (mapcar
                    '(lambda (x)
                      (if (listp x)
                        (strcat
                          "("
                          (itoa (car x))
                          " . "
                          (cond
                            ((eq (car x) 1002) (strcat (if (eq (cdr x) "{") "\"(\"" "\")\"")))
                            ((member (car x) '(1000 1003 1004 1005)) (strcat "\"" (cdr x) "\""))
                            ((member (car x) '(1040 1041 1042)) (rtos (cdr x)))
                            ((member (car x) '(1070 1071)) (itoa (cdr x)))
                            ((member (car x) '(1010 1011 1012 1013 1020 1021 1022 1023 1030 1031 1032 1033)) (strcat "(" (rtos (cadr x)) "," (rtos (caddr x)) "," (rtos (cadddr x)) ")"))
                          )
                          ")\\P"
                        )
                        (strcat "{\\C" (itoa (setq ncol (+ 10 ncol))) " " (car data)"}" "\\P")
                      )
                    )
                    data
                  )
                )
              )
            )
          )
        )
        (if strcatlst
          (progn
            (mapcar 
              '(lambda (pr val)
                (vlax-put nw_obj pr val)
              )
              (list 'InsertionPoint 'Height 'TextString)
              (list (mapcar '- (getvar "VIEWCTR") (list (* (getvar "VIEWSIZE") 0.5) (- (* (getvar "VIEWSIZE") 0.5)) 0.0)) (/ (getvar "VIEWSIZE") 100.0) (strcat "{\\fArial;" strcatlst "}" ))
            )
          )
          (vlax-put nw_obj 'TextString "")
        )
        (setq strcatlst nil)
      )
      (T (vlax-put nw_obj 'TextString ""))
    )
  )
  (vla-Delete nw_obj)
  (and save_ucs (vla-put-activeUCS AcDoc save_ucs))
  (and WCS (vla-delete WCS) (setq WCS nil))
  (prin1)
)

 

Modifié le 12 juillet 2022 par bonuscad
Rajout pour affichage lors du survol d'un attribut de bloc

[lecrabe]

Hello

BRAVO Bruno tu m'as devance car j'allais copier / coller ton code de "dyn_read_xdata" ...

Bonne journee, Bye, lecrabe

 

[JPhil]

Merci @bonuscad pour ton lisp.
Puis-je me permettre une remarque ?
J'ai fait un test et ça fonctionne plutôt bien, néanmoins j'ai trouvé la limite.
Lorsqu'on survole un bloc sur sa partie dessin, le lisp affiche bien toutes données, par contre lorsqu'on survole un des attributs du même bloc, le lisp n'affiche pas toutes les données.
Penses-tu qu'il soit facile d'y remédier ?
Merci par avance.

[bonuscad]

@JPhil

Merci du retour,

J'ai mis à jour le post du code pour prendre en considération le survol d'attributs d'un bloc.

J'ai testé rapidement, cela semble bon...

[JPhil]

Merci @bonuscad
Effectivement c'est vachement mieux maintenant.