Aller au contenu

Arrondir les coordonnées


KHdA

Messages recommandés

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

 

Lien vers le commentaire
Partager sur d’autres sites

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)

))

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

Lien vers le commentaire
Partager sur d’autres sites

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

Lien vers le commentaire
Partager sur d’autres sites

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

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

Lien vers le commentaire
Partager sur d’autres sites

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

 

Lien vers le commentaire
Partager sur d’autres sites

  • 8 ans après...

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

Autodesk Architecture 2023 sous windows 11 64

24 pouces vertical + 30 pouces horizontal + 27 pouces horizontal

Lien vers le commentaire
Partager sur d’autres sites

  • 3 ans après...

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

Autodesk Architecture 2023 sous windows 11 64

24 pouces vertical + 30 pouces horizontal + 27 pouces horizontal

Lien vers le commentaire
Partager sur d’autres sites

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

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

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é