inserer un bloc dyn, avec attributs et annotatif polyligne3D

[tge]

Bonjour,

je souhaiterais inserer un bloc dynamique, avec attributs et annotatif automatiquement

sur les sommets d'une polyligne 3d ou 2d ... (par exemple un bloc coordonnées XYZ)

j'ai essayé d'inserer mon bloc avec la commande BLP.lsp du lisp de Gilles Chanteau...

l'insertion des blocs se fait correctement, mais l'échelle annotative ne correspond pas à mon échelle annotative courante (elle est de 1:1000 ...par défaut ?) et les attributs de mes blocs ont disparus...

il y a-t-il un lisp qui traite de ce sujet ? j'ai fouillé mais sans succés....

merci

 

ps: je suis sur Autocad V2008

[rebcao]

Bonjour,

 

Il doit y avoir une confusion ,§ L'ANNOTATIF n'existe que depuis la version 2008 !

 

Christian

[tge]

oui, je suis sur Autocad V2008...

[rebcao]

Parce que Forum 2007 !

 

Christian

[tge]

effectivement je suis sur le forum 2007....

mon sujet s'est mis 4x sur 2008 et 2x sur 2007 ! :-)

M.REB, je vous ai envoyé un mail sur le site REBACO.fr pour une demande de formation LISP...

(thierry Gaudaré), je ne sais pas si ce mail vous est parvenu ?

 

[bryce]

Bonjour,

 

J'ai fait un petit lisp qui devrait répondre à ta demande :

 

http://file.ahst.fr/get.php?id=4d604f06de71b

 

(defun c:POLYBLOC (/ oldosmode oldcmdecho olderr doc spc pardefaut ok bloc gb poly pts pt)
;;; POLYBLOC V1.1
;;; Insère un bloc sur chaque sommet de la polyligne sélectionnée.
;;; Le bloc doit exister dans le dessin. Il peut être annotatif et comporter des attributs.

;;; par Brice Studer - février 2011

(vl-load-com)

~~~~~~~~~ GESTION ERREURS ~~~~~~~~~
(defun initerr()
(setq oldosmode (getvar "osmode"))
(setq oldcmdecho (getvar "cmdecho"))
(command "_.undo" "_be")
(setq olderr *error*)
(setq *error* trap)
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(princ)
)

(defun reset()
(command "_.undo" "_e")
(setq *error* olderr)
(setvar "osmode" oldosmode)
(setvar "cmdecho" oldcmdecho)
(princ)
)

(defun trap(errmsg)
(command nil nil nil)
(princ (strcat "\nErreur: " errmsg "\n"))
(command "_.undo" "_e")
(setq *error* olderr)
(setvar "osmode" oldosmode)
(setvar "cmdecho" oldcmdecho)
(princ)
)
~~~~~~~~~

(setq spc
(if
  (or
	(eq AcModelSpace
	  (vla-get-ActiveSpace
		(setq doc
		  (vla-get-ActiveDocument
			(vlax-get-acad-object)
		  )
		)
	  )
	)
	(eq :vlax-true (vla-get-MSpace doc))
  )
  (vla-get-ModelSpace doc)
  (vla-get-PaperSpace doc)
)
)

(initerr)

(setq ok nil)
(while (not ok)
(if polyblocbloc
	(setq pardefaut (strcat "<" polyblocbloc ">"))
	(setq pardefaut "")
)
(setq bloc (getstring T (strcat "\nNom du bloc à insérer (ou ? pour choisir) " pardefaut ": ")))
(if (eq bloc "?")
	(if (setq gb (GetBlock()))
		(setq bloc gb)
	)
)
(if (eq bloc "")
	(setq bloc polyblocbloc)
)
(if (or
		(tblsearch "block" bloc)
		gb
	)
	(progn
		(setq ok T)
		(setq polyblocbloc bloc)
	)
	(princ "\nBloc non trouvé !")
)
);while not ok

(while
	(not
		(and
			(setq poly (car (entsel "\nSélectionnez une polyligne: ")))
			(or
				(eq "POLYLINE" (cdr (assoc 0 (entget poly))))
				(eq "LWPOLYLINE" (cdr (assoc 0 (entget poly))))
			)
		)
	)
	(princ "\nL'objet sélectionné n'est pas une polyligne !")
);while

(if
(setq pts (getVertices poly))
(progn
	(foreach pt pts
		(InsertBlock spc bloc pt)
	);foreach
);progn
);if pts

(reset)
);defun POLYBLOC


~~~~~~~~~ SOUS-FONCTIONS ~~~~~~~~~

;;; getVertices
;;; par Serge (http://www.cadxp.com/sujetXForum-106.htm)
(defun getVertices (ename / plineGet return vertex vertexGet)
(setq return nil)
(cond
	((or (/= (type ename) 'ENAME) (not (setq plineGet (entget ename))))
		(setq return nil)
	)
	((= "POLYLINE" (cdr (assoc 0 plineGet)))
		(setq vertex (entnext ename))
		(while (= "VERTEX" (cdr (assoc 0 (setq vertexGet (entget vertex)))))
			(setq return (cons (cdr (assoc 10 vertexGet)) return))
			(setq vertex (entnext vertex))
		)
		(setq return (reverse return))
	)
	((= "LWPOLYLINE" (cdr (assoc 0 plineGet)))
		(setq return (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) plineGet)))
	)
	(t (setq return nil))
);cond
return
);defun getVertices

;;; InsertBlock
;;; par Lee Mac
(defun InsertBlock ( Block Name Point )
(if
 (not
(vl-catch-all-error-p
  (setq result
	(vl-catch-all-apply (function vla-insertblock)
	  (list Block (vlax-3D-point point) Name 1. 1. 1. 0.)
	)
  )
)
 )
 result
)
);defun InsertBlock

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

;;; Getblock (gile) 03/11/07
;;; Retourne le nom du bloc entré ou choisi par l'utilisateur 
;;; dans une liste déroulante de la boite de dialogue ou depuis la boite
;;; de dialogue standard d'AutoCAD
;;; Argument : le titre (string) ou nil (défaut : "Choisir un bloc")

(defun getblock	(titre / bloc n lst tmp file what_next dcl_id nom)
 (while (setq bloc (tblnext "BLOCK" (not bloc)))
   (setq lst (cons (cdr (assoc 2 bloc)) lst)
   )
 )
 (setq	lst  (acad_strlsort
       (vl-remove-if
	 (function (lambda (n) (= (substr n 1 1) "*")))
	 lst
       )
     )
tmp  (vl-filename-mktemp "Tmp.dcl")
file (open tmp "w")
 )
 (write-line
   (strcat
     "getblock:dialog{label="
     (cond (titre (vl-prin1-to-string titre))
    ("\"Choisir un bloc\"")
     )
     ";initial_focus=\"bl\";:boxed_column{
     :row{:text{label=\"Sélectionner\";alignment=left;}
     :button{label=\">>\";key=\"sel\";alignment=right;fixed_width=true;}}
     spacer;
     :column{:button{label=\"Parcourir...\";key=\"wbl\";alignment=right;fixed_width=true;}}
     :column{:text{label=\"Nom :\";alignment=left;}}
     :edit_box{key=\"tp\";edit_width=25;}
     :popup_list{key=\"bl\";edit_width=25;}spacer;}
     spacer;
     ok_cancel;}"
   )
   file
 )
 (close file)
 (setq dcl_id (load_dialog tmp))
 (setq what_next 2)
 (while (>= what_next 2)
   (if	(not (new_dialog "getblock" dcl_id))
     (exit)
   )
   (start_list "bl")
   (mapcar 'add_list lst)
   (end_list)
   (if	(setq n	(vl-position
	  (strcase (getvar "INSNAME"))
	  (mapcar 'strcase lst)
	)
)
     (setq nom (nth n lst))
     (setq nom	(car lst)
    n	0
     )
   )
   (set_tile "bl" (itoa n))
   (action_tile "sel" "(done_dialog 5)")
   (action_tile "bl" "(setq nom (nth (atoi $value) lst))")
   (action_tile "wbl" "(done_dialog 3)")
   (action_tile "tp" "(setq nom $value) (done_dialog 4)")
   (action_tile
     "accept"
     "(setq nom (nth (atoi (get_tile \"bl\")) lst)) (done_dialog 1)"
   )
   (setq what_next (start_dialog))
   (cond
     ((= what_next 3)
      (if (setq nom (getfiled "Sélectionner un fichier" "" "dwg" 0))
 (setq what_next 1)
 (setq what_next 2)
      )
     )
     ((= what_next 4)
      (cond
 ((not (read nom))
  (setq what_next 2)
 )
 ((tblsearch "BLOCK" nom)
  (setq what_next 1)
 )
 ((findfile (setq nom (strcat nom ".dwg")))
  (setq what_next 1)
 )
 (T
  (alert (strcat "Le fichier \"" nom "\" est introuvable."))
  (setq	nom nil
	what_next 2
  )
 )
      )
     )
     ((= what_next 5)
      (if (and	(setq ent (car (entsel)))
	(= "INSERT" (cdr (assoc 0 (entget ent))))
   )
 (setq nom	 (cdr (assoc 2 (entget ent)))
       what_next 1
 )
 (setq what_next 2)
      )
     )
     ((= what_next 0)
      (setq nom nil)
     )
   )
 )
 (unload_dialog dcl_id)
 (vl-file-delete tmp)
 nom
)

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


(princ "\nInsère un bloc du dessin sur chaque sommet de la polyligne sélectionnée.")
(princ "\nCommande à utiliser : POLYBLOC")
(princ)

 

J'ai réutilisé une fonction écrite par Serge pour récupérer les sommets d'une polyligne, merci à lui. ;)

 

Edit: V1.1

- correction de bug, possibilité d'entrer un nom de bloc avec espaces

- ajout d'une option pour choisir un bloc dans une boîte de dialogue, en utilisant la fonction GetBlock de (gile).

 

 

 

[Edité le 19/2/2011 par bryce]

[tge]

Bonjour,

Merci bcp Bryce ! c'est parfait !!!