Extraction de coordonnées

[fanion]

Bonjour,

J'ai une poly sur mon plan qui passe par tous les points de coordonnées d'implantation de mon projet (environ 150). Je souhaiterai extraire les coordonnées de cette moly dans un tableau autocad sans passer par des bloc et extraction de données.

Quelqu'un aurai une idée, voir un ch'tit lisp qui traine sur son ordi?

Merci d'avance

[albator44]

bonjour,

jusqu'à maintenant pour moi LISTE suffisait, mais si quelqu'un a, je suis preneur aussi.

Salut.

[excalibur]

Bonjour,

 

J'utilise la même méthode que Albator44.

C'est très rapide et complet.

[didier]

Bonjour

 

est ce que tu veux que ce soit SPECIFIQUEMENT un TABLEAU

au sens Tableau d'AutoCad,

 

ou bien un fichier XLS ?

 

ou un listing sous forme de tableau dans le dwg ?

 

amicalement

[fanion]

Bien sur, liste marche très bien. Or moi ce que je désire, c'est faire le même principe que l'extraction d'attribut, c'est dire extraction des données, filtre, mise en forme et hop tous le monde dans un petit tableau autocad, que l'on peu mettre à jour si la poly bouge.

[bonuscad]

En repartant de ce sujet , j'ai rapidement adapté pour faire ceci:

 

(defun l-coor2l-pt (lst flag / )
 (if lst
   (cons (list (car lst) (cadr lst) (if flag (caddr lst) 0.0))
     (l-coor2l-pt (if flag (cdddr lst) (cddr lst)) flag)
   )
 )
)
(defun make_field (pt / obj)
(vlax-put (vla-AddPoint Space (vlax-3d-point pt)) 'layer "Id-Point")
(setq obj (entlast))
(mapcar
	'(lambda (lx)
		(apply
			'(lambda (ins_point value_field att_point txt_height dwg_dir name_style name_layer txt_rot / nw_obj)
				(setq nw_obj
					(vla-addMtext Space
						(vlax-3d-point ins_point)
						0.0
						(strcat
							"%[b]<[/b]\\AcObjProp.16.2 Object(%[b]<[/b]\\_ObjId "
							(itoa (vla-get-ObjectID (vlax-ename-[b]>[/b]vla-object obj)))
							value_field
						)
					)
				)
				(mapcar
					'(lambda (pr val)
						(vlax-put nw_obj pr val)
					)
					(list 'AttachmentPoint 'Height 'DrawingDirection 'InsertionPoint 'StyleName 'Layer 'Rotation)
					(list att_point txt_height dwg_dir ins_point name_style name_layer txt_rot)
				)
			)
			lx
		)
	)
	(list
		(list
       pt_ins
			"[b]>[/b]%).Coordinates \\f \"%lu2%pr3\"[b]>[/b]%"
			7
			(getvar "TEXTSIZE")
			5
			"Romand-Field"
			"Id-XYZ"
			rtx
		)
	)
)
(setq pt_ins
	(mapcar '- pt_ins
     (list
        0.0
        (+ (* (getvar "TEXTSIZE") (sin rtx0) 2.0) (* (* (getvar "TEXTSIZE") 2.0) (cos rtx0)))
        0.0
     )
   )
 )
)
(defun c:cell-xyz_field ( / js pt_ins htx rtx rtx0 AcDoc Space ncol nw_style dxf_cod n lremov ent ename l_pt l_pr)
(princ "\nChoix d'un objet modèle pour le filtrage: ")
(while
	(null
		(setq js
			(ssget "_+.:E:S"
				(list
					'(0 . "LINE,POLYLINE,LWPOLYLINE,POINT,ARC,CIRCLE,ELLIPSE,INSERT")
					(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!")
)
(initget 1)
(setq pt_ins (getpoint "\nPoint de départ pour l'écriture des coordonnées: "))
(initget 6)
(setq htx (getdist pt_ins (strcat "\nSpécifiez la hauteur du champ [b]<[/b]" (rtos (getvar "TEXTSIZE")) "[b]>[/b]: ")))
(if htx (setvar "TEXTSIZE" htx))
(if (not (setq rtx (getorient pt_ins "\nSpécifiez l'orientation du champ [b]<[/b]0.0[b]>[/b]: "))) (setq rtx 0.0))
(setq rtx0 (+ (angle '(0 0 0) (getvar "UCSXDIR")) rtx))
(vl-load-com)
(setq
	AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
	Space
	(if (= 1 (getvar "CVPORT"))
		(vla-get-PaperSpace AcDoc)
		(vla-get-ModelSpace AcDoc)
	)
	ncol '(96 2)
)
(foreach n '("Id-XYZ" "Id-Point")
	(cond
		((null (tblsearch "LAYER" n))
			(vlax-put (vla-add (vla-get-layers AcDoc) n) 'color (car ncol))
		)
	)
	(setq ncol (cdr ncol))
)
(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)
		)
	)
)
 (setq dxf_cod (entget (ssname js 0)))
(initget "Unique Multiple _Single Multiple")
(if (eq (getkword "\nSélection filtrée [unique/Multiple][b]<[/b]M[b]>[/b]: ") "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 ename (vlax-ename-[b]>[/b]vla-object (ssname js (setq n (1+ n)))) l_pt nil)
   (setq l_pr (list 'StartPoint 'EndPoint 'Center 'InsertionPoint 'Coordinates 'FitPoints))
   (foreach n l_pr
     (if (vlax-property-available-p ename n)
       (setq l_pt
         (if (eq n 'Coordinates)
           (progn
             (append
               (if (eq (vla-get-ObjectName ename) "AcDbPolyline")
                 (l-coor2l-pt (vlax-get ename n) nil)
                 (l-coor2l-pt (vlax-get ename n) T)
               )
               l_pt
             )
           )
           (cons (vlax-get ename n) l_pt)
         )
       )
     )
   )
   (mapcar 'make_field l_pt)
(setq pt_ins
	(mapcar '- pt_ins
     (list
        0.0
        (+ (* (getvar "TEXTSIZE") (sin rtx0) 2.0) (* (* (getvar "TEXTSIZE") 2.0) (cos rtx0)))
        0.0
     )
   )
 )
)
(prin1)
)

 

Comme visible dans le code fonctionne pour:

LINE,POLYLINE,LWPOLYLINE,POINT,ARC,CIRCLE,ELLIPSE,INSERT