Aller au contenu

Bloc avec champ dynamique


(gile)

Messages recommandés

@(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)
) 
Lien vers le commentaire
Partager sur d’autres sites

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)
)

 

Gilles Chanteau - gileCAD -
Développements sur mesure pour AutoCAD
ADSK_Expert_Elite_Icon_S_Color_Blk_125.png

Lien vers le commentaire
Partager sur d’autres sites

@(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)
)

Lien vers le commentaire
Partager sur d’autres sites

Créer un compte ou se connecter pour commenter

Vous devez être membre afin de pouvoir déposer un commentaire

Créer un compte

Créez un compte sur notre communauté. C’est facile !

Créer un nouveau compte

Se connecter

Vous avez déjà un compte ? Connectez-vous ici.

Connectez-vous maintenant
×
×
  • Créer...

Information importante

Nous avons placé des cookies sur votre appareil pour aider à améliorer ce site. Vous pouvez choisir d’ajuster vos paramètres de cookie, sinon nous supposerons que vous êtes d’accord pour continuer. Politique de confidentialité