Aller au contenu

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


l56
 Partager

Messages recommandés

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

Lien vers le commentaire
Partager sur d’autres sites

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é par bonuscad
Rajout pour affichage lors du survol d'un attribut de bloc
  • Upvote 1

Choisissez un travail que vous aimez et vous n'aurez pas à travailler un seul jour de votre vie. - Confucius

Lien vers le commentaire
Partager sur d’autres sites

  • 1 mois après...

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.

Lien vers le commentaire
Partager sur d’autres sites

Créer un compte ou se connecter pour commenter

Vous devez être membre afin de pouvoir déposer un commentaire

Créer un compte

Créez un compte sur notre communauté. C’est facile !

Créer un nouveau compte

Se connecter

Vous avez déjà un compte ? Connectez-vous ici.

Connectez-vous maintenant
 Partager

×
×
  • Créer...

Information importante

Nous avons placé des cookies sur votre appareil pour aider à améliorer ce site. Vous pouvez choisir d’ajuster vos paramètres de cookie, sinon nous supposerons que vous êtes d’accord pour continuer. Politique de confidentialité