Les Annotations (ACAD 2008/2009/2010)

[lecrabe]

 

Hello

 

Sujet : Les Annotations (ACAD 2008/2009/2010)

 

Lorsque l'on utilise un style de texte Annotatif (en fait avec un style Annotatif) et des Blocs (Symboles) Annotatifs, il est possible de deplacer visuellement le Texte ou Bloc

dans chaque fenetre de presentation (du moins pour une echelle donnee)

afin de le placer au mieux visuellement par rapport aux autres objets dessines ...

 

Lorsque j'interroge un texte NORMAL en Lisp, par exemple :

Commande: EE

Choix de l'objet: ((-1 . ) (0 . "TEXT") (330 .

d'entité: 7ef05cf8>) (5 . "17DEF") (100 . "AcDbEntity") (67 . 0) (410 .

"Model") (8 . "TEXTE_PAYS") (100 . "AcDbText") (10 831561.0 2.2278e+006 0.0)

(40 . 10000.0) (1 . "FRANCE") (50 . 0.0) (41 . 1.0) (51 . 0.0) (7 . "T_PAYS")

(71 . 0) (72 . 0) (11 0.0 0.0 0.0) (210 0.0 0.0 1.0) (100 . "AcDbText") (73 .

0))

 

Lorsque j'interroge un texte Annotatif en Lisp, par exemple :

Commande: EE

Choix de l'objet: ((-1 . ) (0 . "TEXT") (5 . "2A8A")

(102 . "{ACAD_XDICTIONARY") (360 . ) (102 . "}") (330 .

) (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 .

"FR_DEPART_NOM") (100 . "AcDbText") (10 897147.0 2.23836e+006 0.0) (40 .

5000.0) (1 . "Doubs") (50 . 0.0) (41 . 1.0) (51 . 0.0) (7 . "Arial") (71 . 0)

(72 . 0) (11 0.0 0.0 0.0) (210 0.0 0.0 1.0) (100 . "AcDbText") (73 . 0) (-3

("AcadAnnotative" (1000 . "AnnotativeData") (1002 . "{") (1070 . 1) (1070 . 1)

(1002 . "}"))))

 

Lorsque j'interroge un bloc NORMAL en Lisp, par exemple :

Commande: EE

Choix de l'objet: ((-1 . ) (0 . "INSERT") (330 .

d'entité: 7ef05cf8>) (5 . "41C3") (100 . "AcDbEntity") (67 . 0) (410 . "Model")

(8 . "FR_BLOC") (62 . 7) (100 . "AcDbBlockReference") (2 . "NORD_BO2") (10

927657.0 2.198e+006 0.0) (41 . 10000.0) (42 . 10000.0) (43 . 10000.0) (50 .

0.0) (70 . 0) (71 . 0) (44 . 0.0) (45 . 0.0) (210 0.0 0.0 1.0))

 

Lorsque j'interroge un bloc Annotatif en Lisp, par exemple :

Commande: EE

Choix de l'objet: ((-1 . ) (0 . "INSERT") (5 . "3A49")

(102 . "{ACAD_XDICTIONARY") (360 . ) (102 . "}") (330 .

) (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 .

"FR_BLOC") (100 . "AcDbBlockReference") (2 . "ANN_PATRICE") (10 914535.0

2.22983e+006 0.0) (41 . 1.0) (42 . 1.0) (43 . 1.0) (50 . 0.0) (70 . 0) (71 . 0)

(44 . 0.0) (45 . 0.0) (210 0.0 0.0 1.0))

 

Donc je sens bien qu'il y a des XDATAs et Dictionnary derriere ...

C bien au dela de mes competences !

 

Serait il possible d'avoir un programme Lisp qui sur une selection d'un Texte

(ou peut etre aussi MText) ou Bloc ANNOTATIF affiche / defile

dans l'ecran texte, les infos suivantes :

- Proprietes normales : point d'insertion XYZ, rotation, facteur d'echelle, nom de bloc ou contenu du texte, etc

Puis par Echelle d'Annotation utilisee dans les Fenetres de presentation

les memes infos ou presque, en fait c surtout le point d'insertion "relatif" qui m'interesse !

 

Je ne sais pas si je me suis bien exprime !

 

Merci d'avance, Le Decapode

 

[(gile)]

Salut,

 

Un premier jet :

 

(defun c:toto (/ ent elst xDict dict scl slst)
 (if (and
(setq ent (ssget "_:S:E" '((0 . "TEXT,INSERT"))))
(setq ent (ssname ent 0))
(setq elst (entget ent))
     )
   (progn
     (if (= (cdr (assoc 0 elst)) "TEXT")
(princ (strcat
	 "\nTexte : "
	 (cdr (assoc 1 elst))
	 "\nRotation : "
	 (angtos (cdr (assoc 50 elst)))
	 "\nPoint d'insertion courant : "
	 (vl-princ-to-string (cdr (assoc 10 elst)))
       )
)
(princ (strcat
	 "\nBloc : "
	 (cdr (assoc 2 elst))
	 "\nRotation : "
	 (angtos (cdr (assoc 50 elst)))
	 "\nEchelle : "
	 (if (cdr (assoc 41 eslt))
	   (rtos (cdr (assoc 41 eslt)))
	   (rtos 1.)
	 )
	 "\nPoint d'insertion courant : "
	 (vl-princ-to-string (cdr (assoc 10 elst)))
       )
)
     )
     (if (and
    (setq xDict (gc:GetExtDict ent))
    (setq dict (dictsearch xDict "AcDbContextDataManager"))
    (setq dict (dictsearch
		 (cdr (assoc -1 dict))
		 "ACDB_ANNOTATIONSCALES"
	       )
    )
  )
(progn
  (princ "\nPoints d'insertions suivant échelles")
  (foreach p (gc:GetDictEntries dict)
    (setq scl
	   (cdr
	     (assoc 300 (entget (cdr (assoc 340 (entget (cdr p))))))
	   )
    )
    (if	(not (vl-position scl slst))
      (progn
	(setq slst (cons scl slst))
	(princ
	  (strcat
	    "\n"
	    scl
	    " : "
	    (vl-princ-to-string
	      (cdr (assoc 10 (entget (cdr p))))
	    )
	  )
	)
      )
    )
  )
)
     )
     (textscr)
   )
 )
 (princ)
)


;;;============================================================;;;

;; gc:GetExtDict (gile)
;; Retourne le dictionnaire d'extension de l'entité (ou nil)
;;
;; Argument : ent (ENAME) le nom de l'entité

(defun gc:GetExtDict (ent)
 (cdr
   (assoc 360
   (member '(102 . "{ACAD_XDICTIONARY") (entget ent))
   )
 )
)

;;;============================================================;;;

;; gc:GetDictEntries
;; Retourne la liste des entrées du dictionnaire
;; sous forme de paires pointées (Nom . ENAME)
;;
;; Argument : dict (ENAME ou liste DXF) le dictionnaire

(defun gc:GetDictEntries (dict / result)
 (and (= (type dict) 'ENAME) (setq dict (entget dict)))
 (while
   (setq dict (vl-member-if
	 (function (lambda (x) (= (car x) 3)))
	 (cdr dict)
       )
   )
    (setq result (cons (cons (cdar dict) (cdadr dict)) result))
 )
 (reverse result)
)

[lecrabe]

 

Hello Gilles

 

Je suis impressionne pat ton talent et ton experience ! :)

 

Ca marche d'enfer ton programme "TOTO" que j'ai renomme en "Annot_Infos" :D

Test rapide realise avec MAP 2009

 

Je vais faire d'autres tests plus pousses demain ...

 

Encore Merci, Le Decapode

 

 

[lecrabe]

 

Hello

 

SVP Gilles, puis je te solliciter encore pour te demander qq ameliorations :

de cet excellent programme "Annot_Infos"

 

- Selection AutoCAD classique (N entites)

- Afficher le nom du calque

- Traiter les MTexts (en plus des Texts et Blocs)

 

- Traiter eventuellement : hatch, cotation, etc

en affichant les proprietes principales ...

 

Autre routine "rapide et efficace" mais j'ai peut etre loupe qq chose : Annot_Reset

- Selection AutoCAD classique (N entites)

- Suppression de toutes les caracteristiques d'affichage liees aux echelles d'annotation utilisees

et traitement de TOUS les objets annotatifs : bloc, text, mtext, hatch, cotation, ligne de repere, etc

 

Merci d'avance, Le Decapode

 

 

 

[(gile)]

Salut,

 

Quelque chose comme ça ?

 

(defun c:Annot_Infos (/ ss n ent elst xDict dict scl slst)
 (if (and
(setq n 0)
(setq ss (ssget '((0 . "MTEXT,TEXT,INSERT"))))
     )
   (while (setq ent (ssname ss n))
     (setq n	 (1+ n)
    elst (entget ent)
    slst nil
     )
     (cond
((wcmatch (cdr (assoc 0 elst)) "*TEXT")
 (princ	(strcat
	  (if (= (cdr (assoc 0 elst)) "MTEXT")
	    "\nMtexte : "
	    "\nTexte : "
	  )
	  (cdr (assoc 1 elst))
	  "\nCalque : "
	  (cdr (assoc 8 elst))
	  "\nRotation : "
	  (angtos (cdr (assoc 50 elst)))
	  "\nPoint d'insertion courant : "
	  (vl-princ-to-string (cdr (assoc 10 elst)))
	)
 )
)
((= (cdr (assoc 0 elst)) "INSERT")
 (princ	(strcat
	  "\nBloc : "
	  (cdr (assoc 2 elst))
	  "\nCalque : "
	  (cdr (assoc 8 elst))
	  "\nRotation : "
	  (angtos (cdr (assoc 50 elst)))
	  "\nEchelle : "
	  (if (cdr (assoc 41 eslt))
	    (rtos (cdr (assoc 41 eslt)))
	    (rtos 1.)
	  )
	  "\nPoint d'insertion courant : "
	  (vl-princ-to-string (cdr (assoc 10 elst)))
	)
 )
)
     )
     (if (and
    (setq xDict (gc:GetExtDict ent))
    (setq dict (dictsearch xDict "AcDbContextDataManager"))
    (setq dict (dictsearch
		 (cdr (assoc -1 dict))
		 "ACDB_ANNOTATIONSCALES"
	       )
    )
  )
(progn
  (princ "\nPoints d'insertions suivant échelles")
  (foreach p (gc:GetDictEntries dict)
    (setq scl
	   (cdr
	     (assoc 300 (entget (cdr (assoc 340 (entget (cdr p))))))
	   )
    )
    (if	(not (vl-position scl slst))
      (progn
	(setq slst (cons scl slst))
	(princ
	  (strcat
	    "\n"
	    scl
	    " : "
	    (vl-princ-to-string
	      (if (= (cdr (assoc 0 elst)) "MTEXT")
		(cdr (assoc 11 (entget (cdr p))))
		(cdr (assoc 10 (entget (cdr p))))
	      )
	    )
	  )
	)
      )
    )
  )
)
     )
     (textscr)
   )
 )
 (princ)
)


;;;============================================================;;;

;; gc:GetExtDict (gile)
;; Retourne le dictionnaire d'extension de l'entité (ou nil)
;;
;; Argument : ent (ENAME) le nom de l'entité

(defun gc:GetExtDict (ent)
 (cdr
   (assoc 360
   (member '(102 . "{ACAD_XDICTIONARY") (entget ent))
   )
 )
)

;;;============================================================;;;

;; gc:GetDictEntries
;; Retourne la liste des entrées du dictionnaire
;; sous forme de paires pointées (Nom . ENAME)
;;
;; Argument : dict (ENAME ou liste DXF) le dictionnaire

(defun gc:GetDictEntries (dict / result)
 (and (= (type dict) 'ENAME) (setq dict (entget dict)))
 (while
   (setq dict (vl-member-if
	 (function (lambda (x) (= (car x) 3)))
	 (cdr dict)
       )
   )
    (setq result (cons (cons (cdar dict) (cdadr dict)) result))
 )
 (reverse result)
)

[lecrabe]

 

Hello Gilles

 

MERCI comme d'hab., cela fonctionne nickel-chrome ! :)

 

Neanmoins je reitere ma demande concernant le Nettoyage VIOLENT de DEFINITIF de toutes les echelles d'annotation meme si elles sont utilisees sur les objets provenant d'une selection AutoCAD classique ! :P

 

Car la commande ECHELLEOBJET ("_objectscale") ne peut nettoyer que les echelles non utilisees et les differentes routines que j'ai trouvees font de meme ! :exclam:

 

Ou bien j'ai loupe qq chose !?

 

Encore Merci, Le Decapode "Annotations Regulateur"

 

[(gile)]

Salut,

 

Quelque chose comme ça ?

 

;; REMOVEALLSCALES (gile)
;; Supprime toutes les échelles excepté "1:1"

(defun c:RemoveAllScales (/ dict)
 (entmod (vl-remove-if
           '(lambda (x) (or (= (car x) 3) (= (car x) 350)))
           (setq dict (dictsearch (namedobjdict) "ACAD_SCALELIST"))
         )
 )
 (setq dict (cdr (assoc -1 dict)))
 (dictadd dict
            "A0"
            (entmakex
              '((0 . "SCALE")
                (100 . "AcDbScale")
                (300 . "1:1")
                (140 . 1.0)
                (141 . 1.0)
              )
            )
   )
 (princ)
)

[lecrabe]

 

Hello

 

Merci Gilles je n'ai pas de version 2008/2009/2010 sous la main a l'instant T !

 

Question cette version fait elle un REMOVE Global General ?

C'est l'impression que je subodore !

 

ou bien permet t-elle une selection AutoCAD classique pour ne traiter que certains objets ?

 

Merci de ta eponse et/ou petite modif de la routine !

 

Le Decapode

 

[(gile)]

Salut,

 

J'avais lu un peu vite, effectivement la routine ci-dessus supprime globalement les échelles annotatives.

 

Deux pour le prix d'un !!!

La routine AnnotOff supprime l'annotativité des objets sélectionnés (MTEXT, TEXT, DIMENSION, LEADER, MULTILEADER).

La routine AnnotOn rend associatifs les objets sélectionnés.

Je n'ai pas trouvé pour les blocs (d'ailleurs l'annotativité des blocs est en lecture seule dans la fenêtre des propriétés)

 

(defun gc:SetAnnotative (ent flag / elst typ)
 (setq	elst (entget ent '("AcadAnnotative"))
typ  (cdr (assoc 0 elst))
 )
 (cond
   ((member typ '("MTEXT" "TEXT" "DIMENSION" "LEADER"))
    (setq xdatas (reverse (cadr (assoc -3 elst))))
    (entmod
      (subst
 (list -3
       (reverse (subst (cons 1070 flag) (assoc 1070 xdatas) xdatas))
 )
 (assoc -3 elst)
 elst
      )
    )
   )
   ((= typ "MULTILEADER")
    (setq elst (reverse elst))
    (entmod (reverse (subst (cons 293 flag) (assoc 293 elst) elst)))
   )
 )
)

;;;============================================================;;;

;; Désactive l'annotativité des objets sélectionnés
(defun c:AnnotOff	(/ ss ent)
 (if (setq n  -1
    ss (ssget '((0 . "MTEXT,TEXT,DIMENSION,LEADER,MULTILEADER")))
     )
   (while (setq ent (ssname ss (setq n (1+ n))))
     (gc:SetAnnotative ent 0)
   )
 )
 (princ)
)

;;;============================================================;;;

;; Active l'annotatvité des objets sélectionnés

(defun c:AnnotOn	(/ ss ent)
 (if (setq n  -1
    ss (ssget '((0 . "MTEXT,TEXT,DIMENSION,LEADER,MULTILEADER")))
     )
   (while (setq ent (ssname ss (setq n (1+ n))))
     (gc:SetAnnotative ent 1)
   )
 )
 (redraw)
 (princ)
)

[(gile)]

Salut,

 

La version ci-dessus de REMOVEALLSCALES ne fonctionnait pas avec AutoCAD 2012+

 

La version ci-dessous devrait corriger ce problème.

 

;; REMOVEALLSCALES (gile)
;; Supprime toutes les échelles excepté "1:1"

(defun c:RemoveAllScales (/ dict)
 (entmod (vl-remove-if
    '(lambda (x) (or (= (car x) 3) (= (car x) 350)))
    (setq dict (dictsearch (namedobjdict) "ACAD_SCALELIST"))
  )
 )
 (dictadd (cdr (assoc -1 dict))
   "A0"
   (entmakex
     '((0 . "SCALE")
       (100 . "AcDbScale")
       (70 . 0)
       (300 . "1:1")
       (140 . 1.0)
       (141 . 1.0)
       (290 . 1)
      )
   )
 )
 (setvar "CANNOSCALE" "1:1")
 (princ)
)

[lecrabe]

Hello Gilles

 

1) Merci d'avoir ameliore/corrige ta routine suite a ma demande ...

 

2) En tant que "Alpha/Beta/Tester/Tripatouilleur", j'ai teste (Ma passion !) ta routine sur 6 versions differentes d'AutoCAD MAP x64 sous Win Seven Pro x64 : 2015, 2014, 2013, 2012, 2011, 2010

TOUS les tests ont ete realises sur le MEME PC (Ancien Portable Dell Precision M4600 - 20 Go Ram - Quadro 1000M 2 Go - DD SATA 500 Go) qui a de multiples versions de nombreux logiciels Autodesk ...

 

Comme d'habitude cela marche Nickel-Chrome !

 

... Cette routine peut aussi tourner en Script ...

 

Thks, Bye, lecrabe