Bloc avec champ dynamique

[(gile)]

il y a 56 minutes, drault a dit :

@(gile)Au moment de lancer le LISP j'ai une erreur.

Quel LISP ? Il y a eu tellement de versions...

Sans voir le code, je ne peux rien dire.

[drault]

@(gile)le tout 1er.

Bloc créé avec les attributs.

Quand je lance la commande après avoir sélectionné une poly-ligne, une erreur est renvoyée. Je donne une explication simple dans le nom du fichier lisp pour me rappeler de son usage.

"Commande: APPLOAD
Pline_block (bloc avec nom aire perimetre dynamique = selection polyligne).lsp correctement chargé(s)
Commande: ; erreur: placement incorrect d'un point en entrée"

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

(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)
	long (strcat "%			     (itoa id)
		     ">%).Length>%"
	     )
	aire (strcat "%			     (itoa id)
		     ">%).Area \\f \"%lu6%qf1\">%"
	     )
  )
  (initget 1)
  (setq nom (getstring T "\nNom de la pièce: "))
  (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 long aire)
	  )
  (vla-regen AcDoc acActiveViewport)
)
(alert "L'objet sélectionné n'est pas une polyligne.")
     )
   )
   (alert "Le bloc \"Pline_block\" est introuvable.")
 )
 (princ)
) 

[(gile)]

Le formatage du (nouveau) site a bouffé une partie du code.

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

(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)
		long (strcat "%<\\AcObjProp Object(%<\\_ObjId "
			     (itoa id)
			     ">%).Length \\f \"%lu2\">%"
		     )
		aire (strcat "%<\\AcObjProp Object(%<\\_ObjId "
			     (itoa id)
			     ">%).Area \\f \"%lu6%qf1\">%"
		     )
	  )
	  (initget 1)
	  (setq nom (getstring T "\nNom de la pièce: "))
	  (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 long aire)
	  )
	  (vla-regen AcDoc acActiveViewport)
	)
	(alert "L'objet sélectionné n'est pas une polyligne.")
      )
    )
    (alert "Le bloc \"Pline_block\" est introuvable.")
  )
  (princ)
)

 

[drault]

@(gile) Merci , oui effectivement ton code marche mieux ainsi.

Encore une fois, très utile!

 

Je me suis permis de trifouiller pour indiquer

"Perimetre : X m

Surface: X m2"

car le mot Périmètre crée un bug de lettrage et je trouvais sympa d'avoir l'info aussi pour la surface.

 

 

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

(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)
        long (strcat "%<\\AcObjProp Object(%<\\_ObjId "
                 (itoa id)
                 ">%).Length \\f \"%lu2%pr2%ps[Perimetre : , m]%ct8[0.01]\">%"
             )
        aire (strcat "%<\\AcObjProp Object(%<\\_ObjId "
                 (itoa id)
                 ">%).Area \\f \"%lu2%pr2%ps[Surface : , m2]%ct8[0.0001]\">%"
             )
      )
      (initget 1)
      (setq nom (getstring T "\nNom de la pièce: "))
      (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 long aire)
      )
      (vla-regen AcDoc acActiveViewport)
    )
    (alert "L'objet sélectionné n'est pas une polyligne.")
      )
    )
    (alert "Le bloc \"Pline_block\" est introuvable.")
  )
  (princ)
)