Aller au contenu
Problème de lien d'inscription (résolu ?) ×

Modification d\'un LISP + export sur excel

Invité tichou

Par Invité tichou
dans AutoCAD 2010

 Partager

Messages recommandés

Invité tichou

Invité tichou

Posté(e)
Posté(e)

Bonjour à tous,

 

Je suis nouvelle sur le forum et débutante en LISP...

J'ai pu récupérer ce code, que j'utilise pour inscrire les surfaces de mes hachures à l'intérieur, afin de faire des métrés de plancher.

 

J'aimerais le modifier pour pouvoir ajouter un identifiant unique à chaque surface.

Au lieu d'écrire :

S = 15.20 m²

S = 21.01 m²

etc...

J'aimerais avoir :

ID001 - 15.20 m²

ID002 - 21.01m²

etc...

 

La partie IDxxx étant incrémentée par pas de 1.

 

Par ailleurs, est-il possible de générer en même temps un tableau Excel contenant ces informations (ID + surface correspondante) ?

 

Merci d'avance pour votre aide.

(vl-load-com)
(defun c:surf ( / js obj AcDoc Space nw_style pt htx rtx unit_key unit_draw dxf_cod n ename ll ur nw_obj lremov)
(princ "\nSélectionnez un objet curviligne.")
(while
	(null
		(setq js
			(ssget "_+.:E:S"
				(list
					'(0 . "*POLYLINE,ARC,CIRCLE,ELLIPSE,HATCH")
					(cons 67 (if (eq (getvar "CVPORT") 1) 1 0))
					(cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model"))
					'(-4 . "							'(-4 . "&")
						'(70 . 120)
					'(-4 . "NOT>")
				)
			)
		)
	)
	(princ "\nCe n'est pas un objet curviligne valable pour cette fonction!")
)
(initget 6)
(setq htx (getdist (getvar "VIEWCTR") (strcat "\nSpécifiez la hauteur du champ <" (rtos (getvar "TEXTSIZE")) ">: ")))
(if htx (setvar "TEXTSIZE" htx))
(if (not (setq rtx (getorient (getvar "VIEWCTR") "\nSpécifiez l'orientation du champ <0.0>: "))) (setq rtx 0.0))
(setq
	AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
	Space
	(if (= 1 (getvar "CVPORT"))
		(vla-get-PaperSpace AcDoc)
		(vla-get-ModelSpace AcDoc)
	)
)
(cond
	((null (tblsearch "LAYER" "Id-Surfaces"))
		(vlax-put (vla-add (vla-get-layers AcDoc) "Id-Surfaces") 'color 96)
	)
)
(cond
	((null (tblsearch "STYLE" "Romand-Field"))
		(setq nw_style (vla-add (vla-get-textstyles AcDoc) "Romand-Field"))
		(mapcar
			'(lambda (pr val)
				(vlax-put nw_style pr val)
			)
			(list 'FontFile 'Height 'ObliqueAngle 'Width 'TextGenerationFlag)
			(list "romand.shx" 0.0 (/ (* 15.0 pi) 180) 1.0 0.0)
		)
	)
)
(if (or (eq (getvar "USERS5") "") (not (eq (substr (getvar "USERS5") 1 2) "qz")))
	(progn
		(initget "KM ME CM MM")
		(if (not (setq unit_key (getkword "\nDessin réalisé en [KM/ME/CM/MM] : ")))
			(setq unit_key "ME")
		)
		(cond
			((eq unit_key "KM")
				(setq unit_draw 1000000)
			)
			((eq unit_key "ME")
				(setq unit_draw 1000 unit_key "M")
			)
			((eq unit_key "CM")
				(setq unit_draw 10)
			)
			((eq unit_key "MM")
				(setq unit_draw 1)
			)
		)
		(setvar "USERS5" (strcat "qz" (itoa unit_draw)))
	)
	(progn
		(setq unit_draw (atoi (substr (getvar "USERS5") 3)))
		(cond
			((eq unit_draw 1000000)
				(setq unit_key "KM")
			)
			((eq unit_draw 1000)
				(setq unit_key "M")
			)
			((eq unit_draw 10)
				(setq unit_key "CM")
			)
			((eq unit_draw 1)
				(setq unit_key "MM")
			)
		)
	)
)
(initget "Unique Multiple _Single Multiple")
(if (eq (getkword "\nSélection filtrée [unique/Multiple]: ") "Single")
   (setq n -1)
   (setq
     dxf_cod (entget (ssname js 0))
     js
     (ssget "_X" 
       (foreach m (foreach n dxf_cod (if (not (member (car n) '(0 67 410 8 6 62 48 420 70))) (setq lremov (cons (car n) lremov))))
         (setq dxf_cod (vl-remove (assoc m dxf_cod) dxf_cod))
       )
     )
     n -1
   )
 )
(repeat (sslength js)
   (setq
     obj (ssname js (setq n (1+ n)))
     ename (vlax-ename->vla-object obj)
   )
   (vla-GetBoundingBox ename 'll 'ur)
		(setq
     ll (safearray-value ll)
     ur (safearray-value ur)
     pt (mapcar '* (mapcar '+ ll ur) '(0.5 0.5 0.5))
     nw_obj
     (vla-addMtext Space
       (vlax-3d-point pt)
       0.0
       (strcat
         "%<\\AcObjProp.16.2 Object(%<\\_ObjId "
         (itoa (vla-get-ObjectID ename))
         ">%).Area \\f \"%lu2%pr2%ps[s=,"
         (strcase unit_key T)
         "²]\">%"
       )
     )
   )
   (mapcar
     '(lambda (pr val)
       (vlax-put nw_obj pr val)
     )
     (list 'AttachmentPoint 'Height 'DrawingDirection 'InsertionPoint 'StyleName 'Layer 'Rotation)
     (list 5 (getvar "TEXTSIZE") 5 pt "Romand-Field" "Id-Surfaces" rtx)
   )
 )
(prin1)
)

bonuscad Collaborator

bonuscad

Posté(e)
Posté(e)

Bonjour,

 

Essayes cette version

 

(vl-load-com)
(defun inc_txt (Txt / Boucle Decalage Val_Txt)
 (setq Boucle 1
 Val_txt ""
 )
 (while (<= Boucle (strlen Txt))
   (setq Ascii_Txt (vl-string-elt Txt (- (strlen Txt) Boucle)))
   (if (not Decalage)
     (setq Ascii_Txt (1+ Ascii_Txt))
   )
   (if (or (= Ascii_Txt 58) (= Ascii_Txt 91) (= Ascii_Txt 123))
     (setq
 Ascii_Txt
  (cond
    ((= Ascii_Txt 58) 48)
    ((= Ascii_Txt 91) 65)
    ((= Ascii_Txt 123) 97)
  )
 Decalage nil
     )
     (setq Decalage T)
   )
   (setq Val_Txt (strcat (chr Ascii_Txt) Val_Txt))
   (setq Boucle (1+ Boucle))
 )
 (if (not Decalage)
   (setq Val_Txt (strcat (cond ((< Ascii_Txt 58) "0")
       ((< Ascii_Txt 91) "A")
       ((< Ascii_Txt 123) "a")
       )
       Val_Txt
     )
   )
 )
 Val_Txt
)
(defun c:Surf ( / js obj AcDoc Space nw_style pt htx rtx unit_key unit_draw dxf_cod n ename ll ur nw_obj lremov)
 (if (eq (getvar "USERS3") "") (setvar "USERS3" "ID000"))
 (princ "\nSélectionnez un objet curviligne.")
 (while
   (null
     (setq js
       (ssget "_+.:E:S"
         (list
           '(0 . "*POLYLINE,ARC,CIRCLE,ELLIPSE,HATCH")
           (cons 67 (if (eq (getvar "CVPORT") 1) 1 0))
           (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model"))
           '(-4 . "              '(-4 . "&")
             '(70 . 120)
           '(-4 . "NOT>")
         )
       )
     )
   )
   (princ "\nCe n'est pas un objet curviligne valable pour cette fonction!")
 )
 (initget 6)
 (setq htx (getdist (getvar "VIEWCTR") (strcat "\nSpécifiez la hauteur du champ <" (rtos (getvar "TEXTSIZE")) ">: ")))
 (if htx (setvar "TEXTSIZE" htx))
 (if (not (setq rtx (getorient (getvar "VIEWCTR") "\nSpécifiez l'orientation du champ <0.0>: "))) (setq rtx 0.0))
 (setq
   AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
   Space
   (if (= 1 (getvar "CVPORT"))
     (vla-get-PaperSpace AcDoc)
     (vla-get-ModelSpace AcDoc)
   )
 )
 (cond
   ((null (tblsearch "LAYER" "Id-Surfaces"))
     (vlax-put (vla-add (vla-get-layers AcDoc) "Id-Surfaces") 'color 96)
   )
 )
 (cond
   ((null (tblsearch "STYLE" "Romand-Field"))
     (setq nw_style (vla-add (vla-get-textstyles AcDoc) "Romand-Field"))
     (mapcar
       '(lambda (pr val)
         (vlax-put nw_style pr val)
       )
       (list 'FontFile 'Height 'ObliqueAngle 'Width 'TextGenerationFlag)
       (list "romand.shx" 0.0 (/ (* 15.0 pi) 180) 1.0 0.0)
     )
   )
 )
 (if (or (eq (getvar "USERS5") "") (not (eq (substr (getvar "USERS5") 1 2) "qz")))
   (progn
     (initget "KM ME CM MM")
     (if (not (setq unit_key (getkword "\nDessin réalisé en [KM/ME/CM/MM] : ")))
       (setq unit_key "ME")
     )
     (cond
       ((eq unit_key "KM")
         (setq unit_draw 1000000)
       )
       ((eq unit_key "ME")
         (setq unit_draw 1000 unit_key "M")
       )
       ((eq unit_key "CM")
         (setq unit_draw 10)
       )
       ((eq unit_key "MM")
         (setq unit_draw 1)
       )
     )
     (setvar "USERS5" (strcat "qz" (itoa unit_draw)))
   )
   (progn
     (setq unit_draw (atoi (substr (getvar "USERS5") 3)))
     (cond
       ((eq unit_draw 1000000)
         (setq unit_key "KM")
       )
       ((eq unit_draw 1000)
         (setq unit_key "M")
       )
       ((eq unit_draw 10)
         (setq unit_key "CM")
       )
       ((eq unit_draw 1)
         (setq unit_key "MM")
       )
     )
   )
 )
 (initget "Unique Multiple _Single Multiple")
 (if (eq (getkword "\nSélection filtrée [unique/Multiple]: ") "Single")
   (setq n -1)
   (setq
     dxf_cod (entget (ssname js 0))
     js
     (ssget "_X" 
       (foreach m (foreach n dxf_cod (if (not (member (car n) '(0 67 410 8 6 62 48 420 70))) (setq lremov (cons (car n) lremov))))
         (setq dxf_cod (vl-remove (assoc m dxf_cod) dxf_cod))
       )
     )
     n -1
   )
 )
 (repeat (sslength js)
   (setq
     obj (ssname js (setq n (1+ n)))
     ename (vlax-ename->vla-object obj)
   )
   (vla-GetBoundingBox ename 'll 'ur)
   (setq
     ll (safearray-value ll)
     ur (safearray-value ur)
     pt (mapcar '* (mapcar '+ ll ur) '(0.5 0.5 0.5))
     nw_obj
     (vla-addMtext Space
       (vlax-3d-point pt)
       0.0
       (strcat
         "%<\\AcObjProp.16.2 Object(%<\\_ObjId "
         (itoa (vla-get-ObjectID ename))
         ">%).Area \\f \"%lu2%pr2%ps["
         (strcat (setvar "USERS3" (inc_txt (getvar "USERS3"))) "-," (strcase unit_key T))
         "²]\">%"
       )
     )
   )
   (mapcar
     '(lambda (pr val)
       (vlax-put nw_obj pr val)
     )
     (list 'AttachmentPoint 'Height 'DrawingDirection 'InsertionPoint 'StyleName 'Layer 'Rotation)
     (list 5 (getvar "TEXTSIZE") 5 pt "Romand-Field" "Id-Surfaces" rtx)
   )
 )
 (prin1)
)

 

puis pour exporter le texte en CSV, ce qui suit

 

(defun c:text_value2csv ( / js dxf_cod mod_sel n lremov file_name cle f_open ename l_pt l_pr nbs)
 (princ "\nChoix d'un objet modèle pour le filtrage: ")
 (while
   (null
     (setq js
       (ssget "_+.:E:S"
         (list
           '(0 . "*TEXT")
           (cons 67 (if (eq (getvar "CVPORT") 1) 1 0))
           (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model"))
         )
       )
     )
   )
   (princ "\nCe n'est pas un objet valable pour cette fonction!")
 )
 (vl-load-com)
 (setq dxf_cod (entget (ssname js 0)))
 (foreach m (foreach n dxf_cod (if (not (member (car n) '(0 67 410 8 6 62 48 420 70))) (setq lremov (cons (car n) lremov))))
   (setq dxf_cod (vl-remove (assoc m dxf_cod) dxf_cod))
 )
 (initget "Unique Tout Manuel _Single All Manual")
 (if (eq (setq mod_sel (getkword "\nMode de sélection filtrée, choix [unique/Tout/Manuel]: ")) "Single")
   (setq n -1)
   (if (eq mod_sel "All")
       (setq js (ssget "_X" dxf_cod) n -1)
       (setq js (ssget dxf_cod) n -1)
   )
 )
 (setq file_name (getfiled "Nom du fichier a créer ?: " (strcat (substr (getvar "dwgname") 1 (- (strlen (getvar "dwgname")) 3)) "csv") "csv" 37))
 (if (null file_name) (exit))
 (if (findfile file_name)
   (progn
     (prompt "\nFichier éxiste déjà!")
     (initget "Ajoute Remplace annUler _Add Replace Undo")
     (setq cle
       (getkword "\nDonnées dans fichier? [Ajouter/Remplacer/annUler] : ")
     )
     (cond
       ((eq cle "Add")
         (setq cle "a")
       )
       ((or (eq cle "Replace") (eq cle ()))
         (setq cle "w")
       )
       (T (exit))
     )
     (setq f_open (open file_name cle))
   )
   (setq f_open (open file_name "w"))
 )
 (repeat (sslength js)
   (setq ename (vlax-ename->vla-object (ssname js (setq n (1+ n)))) l_pt nil)
   (setq l_pr (list 'TextString) nbs 0)
   (foreach n l_pr
     (if (vlax-property-available-p ename n)
       (setq l_pt
         (cons (vlax-get ename n) l_pt)
       )
     )
   )
   (foreach n l_pt
     (write-line n f_open)
   )
   (write-line "" f_open)
 )
 (close f_open)
 (prin1)
)

Choisissez un travail que vous aimez et vous n'aurez pas à travailler un seul jour de votre vie. - Confucius

Invité tichou

Invité tichou

Posté(e)
Posté(e)

Bonjour,

 

Un énorme merci à BonusCAD qui a su répondre parfaitement à me demande.

Vraiment merci.

 

A bientôt.

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
 Partager
Aller sur la liste des sujets
×
×
  • 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é