Pline_block encore et encore....

[jalna]

Bonjour,

 

Tout le monde connait la routine de (giles) pline_block.....

 

Je m'en sert très souvent, mais je rencontre un problème personnel....

 

Souvent il m'arrive de ne pas faire attention aux calques et d'insérer le bloc sur d'autres calques...

 

D'ou ma question:

 

Serait il possible de l'insérer toujours sur le même calque (TEXTE-SURFACES), voir même de créer le calque s'il n'existe pas....

 

Merci et bonne journée!!

[(gile)]

Salut,

 

Ta demande est spécifique et je n'ai pas envie de modifier encore une fois Pline_block, je pense que la version en téléchargement est assez générique, à chacun de la modifier suivant ses besoins.

 

Je te propose donc d'ajouter à la version que tu utilises l'expression suivante entre l'attributuion de leurs valeurs aux attributs (mapcar '(lambda (x y) ...) et la régénération de la fenêtre (vla-regen AcDoc acActiveViewport) :

 

(and
 (vl-catch-all-error-p
   (vl-catch-all-apply
     'vla-item
     (list (vla-get-Layers AcDoc)
    "TEXTE-SURFACES"
     )
   )
 )
 (vla-add (vla-get-Layers AcDoc)
   "TEXTE-SURFACES"
 )
)
(vla-put-Layer ref "TEXTE-SURFACES") 

[jalna]

Salut (gile)

 

Merci à toi de me filer un coup de main!!!

 

Je suis d'accord c'est une demande spécifique, mais qui peut certainnement interresser d'autres personnes, en imaginant une boite de dialogue ou l'on peu rentrer des noms de calques et ainsi choisir le calque que l'on veut!!, enfin c'est une idée...

 

Sinon j'ai bien collé le bout de code dans mon lisp, mais maintenant, j'ai bien le bloc dans le calque, mais cela ne me rempli plus mes attributs...

 

Désolé pour mon ignorance en prog.

 

Alors voila le code obtenu

 

(mapcar '(lambda (x y) (vla-put-TextString x y))
(and
(vl-catch-all-error-p
(vl-catch-all-apply
'vla-item
(list (vla-get-Layers AcDoc)
"TEXTE-SURFACES"
)
)
)
(vla-add (vla-get-Layers AcDoc)
"TEXTE-SURFACES"
)
)
(vla-put-Layer ref "TEXTE-SURFACES")
)
(vla-regen AcDoc acActiveViewport)

 

J'ai certainnement fait une erreur qui va te faire sourrire.... :D

 

Merci de ton aide!!

[(gile)]

Salut,

 

J'avais laissé des points de suspension dans (mapcar '(lambda (x y) (vla-put-TextString x y) ...) pour dire que c'est entre cette expression, à ne pas modifier dans ton LISP et avant le (vla-regen AcDoc acActiveViewport) qu'ilfaut coller l'expression donnée :

 

(mapcar '(lambda (x y) (vla-put-TextString x y))
	  (vlax-invoke ref 'GetAttributes)
	  (list nom long aire)
  )

(and
(vl-catch-all-error-p
(vl-catch-all-apply
'vla-item
(list (vla-get-Layers AcDoc)
"TEXTE-SURFACES"
)
)
)
(vla-add (vla-get-Layers AcDoc)
"TEXTE-SURFACES"
)
)
(vla-put-Layer ref "TEXTE-SURFACES")


(vla-regen AcDoc acActiveViewport) 

 

[Edité le 13/6/2007 par (gile)]

[jalna]

J'ai encore un soucis!

 

J'ai collé ton code et la j'ai bien le nom de la pièce, mais pas la surface??

 

De plus il se place sur le calque courant, et non pas sur TEXTE-SURFACES!!

 

Merci de ton aide précieuse!

[(gile)]

Pourrais-tu poster le code que tu utilises, j'y insèrerais l'expression ...

[jalna]

Voila le code

;;; Pline_bloc -Gilles Chanteau- 13/09/06
;;; Insère le bloc "pline_block" après sélection d'une polyligne
;;; Attribut 1 : Nom de la pièce
;;; Attribut 2 : Aire de la polyligne

(vl-load-com)
(defun c:pline_block (/ AcDoc Space bloc nom ent aire long ins)
(setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
Space (if (= (getvar "CVPORT") 1)

(vla-get-PaperSpace AcDoc)
(vla-get-ModelSpace AcDoc)
)
)
(cond
((tblsearch "BLOCK" (setq bloc "Pline_block")))
((findfile (setq bloc "Pline_block.dwg")))
(T (setq bloc nil))
)
(if bloc
(progn
(while (not (setq ent (car (entsel)))))
(if (= (cdr (assoc 0 (entget ent))) "LWPOLYLINE")
(progn
(setq obj (vlax-ename->vla-object ent)
id (vla-get-ObjectID obj)
aire (strcat "%<\\AcObjProp Object(%<\\_ObjId "
(itoa id)
">%).Area \\f \"%lu2%pr2%ps%ct8[0.0001]\">%"
)
)
(if (not (setq nom (getname)))
(setq nom "")
)
(initget 1)
(setq ins (trans (getpoint "\nPoint d'insertion: ") 1 0))
(setq ref
(vla-InsertBlock
Space
(vlax-3d-point ins)
bloc
1.0
1.0
1.0
0.0
)
)
(mapcar '(lambda (x y) (vla-put-TextString x y))
(vlax-invoke ref 'GetAttributes)
(list nom aire)
)
(vla-regen AcDoc acActiveViewport)
)
(alert "L'objet sélectionné n'est pas une polyligne.")
)
)
(alert "Le bloc \"Pline_block\" est introuvable.")
)
(princ)
)

 

 

[(gile)]

voilà,

 

comme ça, ça devrait fonctionner

 

;;; Pline_bloc -Gilles Chanteau- 13/09/06
;;; Insère le bloc "pline_block" après sélection d'une polyligne
;;; Attribut 1 : Nom de la pièce
;;; Attribut 2 : Aire de la polyligne

(vl-load-com)
(defun c:pline_block (/ AcDoc Space bloc nom ent aire long ins)
 (setq	AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
Space (if (= (getvar "CVPORT") 1)

	(vla-get-PaperSpace AcDoc)
	(vla-get-ModelSpace AcDoc)
      )
 )
 (cond
   ((tblsearch "BLOCK" (setq bloc "Pline_block")))
   ((findfile (setq bloc "Pline_block.dwg")))
   (T (setq bloc nil))
 )
 (if bloc
   (progn
     (while (not (setq ent (car (entsel)))))
     (if (= (cdr (assoc 0 (entget ent))) "LWPOLYLINE")
(progn
  (setq	obj  (vlax-ename->vla-object ent)
	id   (vla-get-ObjectID obj)
	aire (strcat "%			     (itoa id)
		     ">%).Area \\f \"%lu2%pr2%ps%ct8[0.0001]\">%"
	     )
  )
  (if (not (setq nom (getname)))
    (setq nom "")
  )
  (initget 1)
  (setq ins (trans (getpoint "\nPoint d'insertion: ") 1 0))
  (setq	ref
	 (vla-InsertBlock
	   Space
	   (vlax-3d-point ins)
	   bloc
	   1.0
	   1.0
	   1.0
	   0.0
	 )
  )
  (mapcar '(lambda (x y) (vla-put-TextString x y))
	  (vlax-invoke ref 'GetAttributes)
	  (list nom aire)
  )

  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (and
    (vl-catch-all-error-p
      (vl-catch-all-apply
	'vla-item
	(list (vla-get-Layers AcDoc)
	      "TEXTE-SURFACES"
	)
      )
    )
    (vla-add (vla-get-Layers AcDoc)
	     "TEXTE-SURFACES"
    )
  )
  (vla-put-Layer ref "TEXTE-SURFACES")
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  
  (vla-regen AcDoc acActiveViewport)
)
(alert "L'objet sélectionné n'est pas une polyligne.")
     )
   )
   (alert "Le bloc \"Pline_block\" est introuvable.")
 )
 (princ)
) 

[jalna]

S-U-P-E-R-B-E

 

U-N G-R-A-N-D M-E-R-C-I

 

:D :D :D :D :D :D :D :D :D :D :D :D :D :D :D :D

 

Bon j'arrete, merci à toi de passer du temps afin de résoudre des problèmes....

 

Très bonne journée :P