Modification d\'un LISP + export sur excel

[Invité tichou]

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