Arrondir les coordonnées

[KHdA]

Bonjour à tous,

 

Ayant l'habitude d'échanger des fichiers dwg avec des personnes un peu moins rigoureuses que moi, il m'arrive souvent de devoir réaligner les dessins généralement 'orthogonaux'.

 

P.ex. la ligne qui devrait aller du point (10,10,0) au point (10,50,0) est en réalité une ligne qui va de (10.0001212, 10.00321, 0) à (10.000215, 50,002115, 0.0012)... bref des décimales résiduelles fort disgracieuses... difficiles à repérer et fastidieuses à 'réparer'.... ne me demandez pas d'où elles viennent... elles sont là!

 

Ma question:

Existe-t-il une fonction, un utilitaire ou une procédure qui pourrait arrondir les valeurs (p.ex à l'unité ou à 0.5 ou 0.1 près) d'un dessin (ou mieux d'une sélection ou d'une couche) afin de supprimer 'automatiquement' les décimales 'erronées'?

 

Merci d'avance à tous,

 

KH

 

[bonuscad]

Une ébauche pour une ligne, il faudra améliorer et compléter pour d'autre entités.

((lambda ( / e_line dxf_line dxf_10 dxf_11)

(setq

e_line (entsel "\nChoix d'une ligne: ")

dxf_line (entget (car e_line))

dxf_10 (mapcar '(lambda (x) (atof (rtos x 2 0))) (cdr (assoc 10 dxf_line)))

dxf_11 (mapcar '(lambda (x) (atof (rtos x 2 0))) (cdr (assoc 11 dxf_line)))

dxf_line (subst (cons 10 dxf_10) (assoc 10 dxf_line) dxf_line)

dxf_line (subst (cons 11 dxf_11) (assoc 11 dxf_line) dxf_line)

)

(entmod dxf_line)

(entupd (car e_line))

(princ)

))

[didier]

Bonjour

Salut à Toi, Ô BonusCad

 

je te propose le même type d'ébauche de réflexion

mais en VBA,

à toi de choisir le plus proche de tes affinités

 

Sub TestArrondir()

Dim ObjLigne1 As AcadLine

Dim ObjLigne2 As AcadLine

Dim PD(0 To 2) As Double

Dim PA(0 To 2) As Double

 

ThisDrawing.Utility.GetEntity ObjLigne1, PtSel, "Sélection de la Ligne"

 

 

PD(0) = Fix(ObjLigne1.StartPoint(0))

PD(1) = Fix(ObjLigne1.StartPoint(1))

PD(2) = Fix(ObjLigne1.StartPoint(2))

 

PA(0) = Fix(ObjLigne1.EndPoint(0))

PA(1) = Fix(ObjLigne1.EndPoint(1))

PA(2) = Fix(ObjLigne1.EndPoint(2))

 

ObjLigne1.Delete

Set ObjLigne2 = ThisDrawing.ModelSpace.AddLine(PD, PA)

 

End Sub

 

 

amicalement

[bonuscad]

J'ai essayé de créer une routine plus générale et plus souple.

 

Peut être un peut trop générale, car ce genre de routine utilisé à l'aveugle pour tester peut se révéler falacieuse. Les changements peuvent être imperceptiples (donc on ne s'en apercoit pas) mais hélas effectué dans la base de données du dessin.

 

Cette routine modifiée pourra être plus restrictive. Par exemple enlever les entités ARC et CIRCLE de la liste de filtre, le groupe 40 pour les rayon et les hauteurs de texte.

(defun round_number (xr n / )
(* (fix (atof (rtos (* xr n) 2 0))) (/ 1.0 n))
)
(defun c:regular_draw ( / js n_count prec ent dxf_ent dxf_lst)
(setq js (ssget '((0 . "FACE3D,ARC,ATTDEF,ATTRIB,CIRCLE,ELLIPSE,INSERT,LINE,POLYLINE,LWPOLYLINE,*TEXT,POINT,SHAPE,SOLID,TRACE"))) n_count -1)
(cond
	(js
		(initget 7)
		(setq prec (getreal "\nFacteur d'arrondi à appliquer au point de définition des objets, rayon et hauteur de texte ?: "))
		(setq prec (/ 1 prec))
		(setvar "cmdecho" 0)
		(command "_.undo" "_group")
		(while (setq ent (ssname js (setq n_count (1+ n_count))))
			(setq dxf_ent (entget ent))
			(cond
				((eq (cdr (assoc 0 dxf_ent)) "LWPOLYLINE")
					(setq dxf_lst (cdr dxf_ent) dxf_ent (list (car dxf_ent)))
					(while (cdr dxf_lst)
						(if (eq 10 (caar dxf_lst))
							(setq dxf_ent (cons (cons 10 (mapcar '(lambda (x) (round_number x prec)) (cdar dxf_lst))) dxf_ent))
							(setq dxf_ent (cons (car dxf_lst) dxf_ent))
						)
						(setq dxf_lst (cdr dxf_lst))
					)
					(setq dxf_ent (reverse dxf_ent))
				)
				((eq (cdr (assoc 0 dxf_ent)) "POLYLINE")
					(while (eq (cdr (assoc 0 (setq dxf_ent (entget (entnext (cdar dxf_ent)))))) "VERTEX")
						(setq dxf_ent (subst (cons 10 (mapcar '(lambda (x) (round_number x prec)) (cdr (assoc 10 dxf_ent)))) (assoc 10 dxf_ent) dxf_ent))
						(entmod dxf_ent)
					)
				)
				(T
					(foreach n dxf_ent
						(if (member (car n) '(10 11 12 13 40))
							(if (listp (cdr n))
								(setq dxf_ent (subst (cons (car n) (mapcar '(lambda (x) (round_number x prec)) (cdr n))) (assoc (car n) dxf_ent) dxf_ent))
								(setq dxf_ent (subst (cons (car n) (round_number (cdr n) prec)) (assoc (car n) dxf_ent) dxf_ent))
							)
						)
					)
				)
			)
			(entmod dxf_ent)
			(entupd ent)
		)
		(command "_.undo" "_end")
		(setvar "cmdecho" 1)
		(princ (strcat "\n" (itoa n_count) " objet(s) transformé(s)."))
	)
	(T (princ "\Aucun objet valide trouvé."))
)
(prin1)
)

[KHdA]

Cher Bonuscad et Didier,

 

A vous lire, il semble que le problème n'ait pas été posé par ailleurs (Serais-je le seul à renconter de tels problèmes?)

Merci en tout cas pour ces premières solutions (je vais me replonger dans la définition de procédures et les bases du VBA... je dois avouer que ce n'est pas mon domaine de prédilection :-)

Je m'en vais de ce pas tester celles-ci.

 

Si vous avez d'autres solutions je suis toujours preneur.

 

Merci beaucoup,

 

KH

 

[PHILPHIL]

hello bonuscad

 

je viens de trouver ton lisp "regular draw"

 

celui ci ce redessinne tout par rapport au scg

 

pourrait il faire la meme chose par rapport a un scu ?

 

bon week end

 

salut

 

phil

[PHILPHIL]

hello bonuscad

 

3 ans apres

 

les modifications prenne comme base le SCU, comment modifie le lisp pour qu'il prenne en compte un point de base ( scg ) que l'on aurait donné avant de traitement?

 

a+

 

Phil

[bonuscad]

Salut,

 

Hé bin 3 ans après, je répond à ta question (il aurait fallu la relancer avant) :P

 

Essayes la routine modifiée, testée que brièvement.

(defun round_number (xr n / )
(* (fix (atof (rtos (* xr n) 2 0))) (/ 1.0 n))
)
(defun c:regular_draw ( / js n_count ent dxf_ent dxf_lst)
(setq js (ssget '((0 . "FACE3D,ARC,ATTDEF,ATTRIB,CIRCLE,ELLIPSE,INSERT,LINE,POLYLINE,LWPOLYLINE,*TEXT,POINT,SHAPE,SOLID,TRACE"))) n_count -1)
(cond
	(js
		(setvar "cmdecho" 0)
		(command "_.undo" "_group")
		(while (setq ent (ssname js (setq n_count (1+ n_count))))
			(setq dxf_ent (entget ent))
			(cond
				((eq (cdr (assoc 0 dxf_ent)) "LWPOLYLINE")
					(setq dxf_lst (cdr dxf_ent) dxf_ent (list (car dxf_ent)))
					(while (cdr dxf_lst)
						(if (eq 10 (caar dxf_lst))
							(setq dxf_ent (cons (cons 10 (trans (mapcar '(lambda (x p) (round_number x (/ 1 p))) (trans (cdar dxf_lst) 0 1) (getvar "SNAPUNIT")) 1 0)) dxf_ent))
							(setq dxf_ent (cons (car dxf_lst) dxf_ent))
						)
						(setq dxf_lst (cdr dxf_lst))
					)
					(setq dxf_ent (reverse dxf_ent))
				)
				((eq (cdr (assoc 0 dxf_ent)) "POLYLINE")
					(while (eq (cdr (assoc 0 (setq dxf_ent (entget (entnext (cdar dxf_ent)))))) "VERTEX")
						(setq dxf_ent (subst (cons 10 (trans (mapcar '(lambda (x p) (round_number x (/ 1 p))) (trans (cdr (assoc 10 dxf_ent)) 0 1) (append (getvar "SNAPUNIT") (list (car (getvar "SNAPUNIT"))))) 1 0)) (assoc 10 dxf_ent) dxf_ent))
						(entmod dxf_ent)
					)
				)
				(T
					(foreach n dxf_ent
						(if (member (car n) '(10 11 12 13 40))
							(if (listp (cdr n))
								(setq dxf_ent (subst (cons (car n) (trans (mapcar '(lambda (x p) (round_number x (/ 1 p))) (trans (cdr n) 0 1) (append (getvar "SNAPUNIT") (list (car (getvar "SNAPUNIT"))))) 1 0)) (assoc (car n) dxf_ent) dxf_ent))
								(setq dxf_ent (subst (cons (car n) (trans (round_number (trans (cdr n) 0 1) (/ 1 (car (getvar "SNAPUNIT")))) 1 0)) (assoc (car n) dxf_ent) dxf_ent))
							)
						)
					)
				)
			)
			(entmod dxf_ent)
			(entupd ent)
		)
		(command "_.undo" "_end")
		(setvar "cmdecho" 1)
		(princ (strcat "\n" (itoa n_count) " objet(s) transformé(s)."))
	)
	(T (princ "\nAucun objet valide trouvé."))
)
(prin1)
)