SVP Routine : Bloc (NON Annotatif) --> Bloc Annotatif

[lecrabe]

.

Objet: SVP Routine : Bloc (NON Annotatif) --> Bloc Annotatif

 

Hello

 

Dans la serie, il faut s'interesser au Mode ANNOTATIF !

 

SVP je cherche une routine qui :

- Selection AutoCAD classique

Avec possibilite de recuperer la selection precedente

- Ne garder dans la selection que les Blocs NON Annotatifs (et pas les XREFs)

- Poser une question specifique au Mode Annotatif des Blocs :

Faire correspondre l'orientation du bloc a la presentation ... (Defaut=NON) O/N : ?

- Modifier en consequence les N Blocs concernes ...

- On boucle ...

- et a la fin sans doute regenerer le document AutoCAD !?

 

AU FAIT les Blocs concernes peuvent avoir ou pas des attributs (normaux ou champs dynamiques)

et etre ou pas des Blocs dynamiques !? ... Ca change qq chose ??

 

Avec le code (de Lee-mac) que j'ai trouve ...

On a deja la fonction : (defun annotativeblock ( blk )

J'imagine que cela sera relativement FACILE !?

 

Merci d'avance, Bye, lecrabe "triste"

 

 

********** Code de Lee-Mac **********

 

(defun annotativeblock ( blk )

(and (setq blk (tblobjname "block" blk))

(progn

(regapp "AcadAnnotative")

(entmod

(append (entget (cdr (assoc 330 (entget blk))))

'(

( -3

( "AcadAnnotative"

(1000 . "AnnotativeData")

(1002 . "{")

(1070 . 1)

(1070 . 1)

(1002 . "}")

)

)

)

)

)

)

)

)

 

 

 

-- Call the above function with the name of the block to be made annotative:

 

(annotativeblock "myblock")

 

The function will return T if successful.

 

-- For multiple blocks, you can simply call the function from within a loop, e.g.:

 

(foreach blk '("myblock1" "myblock2" "myblock3") (annotativeblock blk))

[(gile)]

Salut,

 

pas vraiment testé.

 

(defun c:setannot (/ ss2bnames annotativeblock ss pos)
 
 (defun ss2bnames (ss / i lst)
   (repeat (setq i (sslength ss))
     (setq name (cdr (assoc 2 (entget (ssname ss (setq i (1- i)))))))
     (if (null (member name lst))
(setq lst (cons name lst))
     )
   )
   lst
 )

 (defun annotativeblock (blk pos)
   (and (setq blk (tblobjname "block" blk))
 (progn
   (regapp "AcadAnnotative")
   (and pos (regapp "AcadAnnoPO"))
   (entmod
     (append
       (entget (cdr (assoc 330 (entget blk))))
       (list
	 (append
	   '(-3)
	   '(("AcadAnnotative"
	      (1000 . "AnnotativeData")
	      (1002 . "{")
	      (1070 . 1)
	      (1070 . 1)
	      (1002 . "}")
	     )
	    )
	   (if pos
	     '(("AcadAnnoPO" (1070 . 1)))
	   )
	 )
       )
     )
   )
 )
   )
 )

 (if (setq ss (ssget '((0 . "INSERT") (2 . "~`*U*"))))
   (progn
     (initget "Oui Non")
     (setq pos
     (=
       "Oui"
       (getkword
	 "\nFaire correspondre l'orientation du bloc a la presentation [Oui/Non] <N>: "
       )
     )
     )
     (foreach b (ss2bnames ss)
(annotativeblock b pos)
     )
   )
 )
 (princ)
)

[lecrabe]

Hello

 

BON MERCI Gilles, la routine est OK !

 

Par contre il faut "marquer" AVANT ( par exemple avec une épaisseur = 0.53mm ) les Blocs concernés pour les retrouver APRES et leur donner les bonnes échelles annotatives...

 

Bon WE, Bye, lecrabe "triste"

[(gile)]

Cette version ajoute l'échelle courante à toutes les références des définitions de bloc modifiées.

 

(defun c:setannot (/ ss2bnames annotativeblock massoc getreferences ss pos)
 
 (defun ss2bnames (ss / i lst)
   (repeat (setq i (sslength ss))
     (setq name (cdr (assoc 2 (entget (ssname ss (setq i (1- i)))))))
     (if (null (member name lst))
(setq lst (cons name lst))
     )
   )
   lst
 )

 (defun annotativeblock (blk pos)
   (and (setq blk (tblobjname "block" blk))
 (progn
   (regapp "AcadAnnotative")
   (and pos (regapp "AcadAnnoPO"))
   (entmod
     (append
       (entget (cdr (assoc 330 (entget blk))))
       (list
	 (append
	   '(-3)
	   '(("AcadAnnotative"
	      (1000 . "AnnotativeData")
	      (1002 . "{")
	      (1070 . 1)
	      (1070 . 1)
	      (1002 . "}")
	     )
	    )
	   (if pos
	     '(("AcadAnnoPO" (1070 . 1)))
	   )
	 )
       )
     )
   )
 )
   )
 )

 (defun massoc (key alst)
 (if (setq alst (member (assoc key alst) alst))
   (cons (cdar alst) (massoc key (cdr alst)))
 )
)

 (defun getreferences (bname / blk refs elst)
   (if
     (and
(setq blk (tblobjname "BLOCK" bname))
(setq refs
       (vl-remove-if-not
	 'cdr
	 (mapcar
	   (function
	     (lambda (x)
	       (if (setq elst (entget x))
		 (cons x (entget (cdr (assoc 330 elst))))
	       )
	     )
	   )
	   (massoc 331 (entget (cdr (assoc 330 (entget blk)))))
	 )
       )
)
     )
      (mapcar 'car refs)
   )
 )

 (if (setq ss (ssget '((0 . "INSERT") (2 . "~`*U*"))))
   (progn
     (initget "Oui Non")
     (setq pos
     (=
       "Oui"
       (getkword
	 "\nFaire correspondre l'orientation du bloc a la presentation [Oui/Non] <N>: "
       )
     )
     )
     (foreach bname (ss2bnames ss)
(annotativeblock bname pos)
(foreach br (getreferences bname)
  (command-s "AIOBJECTSCALEADD" br "" "")
)
     )
   )
 )
 (princ)
)

[lecrabe]

Hello Gilles

 

Un seul mot : BRAVO !

 

MERCI, Bye, lecrabe "triste"