CADxp: Arrondir les coordonnées - CADxp

Aller au contenu

Page 1 sur 1
  • Vous ne pouvez pas commencer un sujet
  • Vous ne pouvez pas répondre à ce sujet

Arrondir les coordonnées

#1 L'utilisateur est hors-ligne   KHdA 

  • ceinture orange
  • Groupe : Membres
  • Messages : 21
  • Inscrit(e) : 24-novembre 04

Posté 04 novembre 2005 - 14:16

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

0

#2 L'utilisateur est hors-ligne   bonuscad 

  • ceinture rouge et blanche 8em dan
  • Groupe : Membres
  • Messages : 4681
  • Inscrit(e) : 20-juin 03

Posté 04 novembre 2005 - 20:45

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

#3 L'utilisateur est hors-ligne   didier 

  • ceinture rouge et blanche 8em dan
  • Groupe : Moderateurs
  • Messages : 8358
  • Inscrit(e) : 18-décembre 02
  • LocationPlanète : Terre

Posté 05 novembre 2005 - 13:41

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
Éternel débutant ...
Programmer AutoCAD
0

#4 L'utilisateur est hors-ligne   bonuscad 

  • ceinture rouge et blanche 8em dan
  • Groupe : Membres
  • Messages : 4681
  • Inscrit(e) : 20-juin 03

Posté 06 novembre 2005 - 23:19

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)

)


0

#5 L'utilisateur est hors-ligne   KHdA 

  • ceinture orange
  • Groupe : Membres
  • Messages : 21
  • Inscrit(e) : 24-novembre 04

Posté 07 novembre 2005 - 11:51

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

0

#6 L'utilisateur est hors-ligne   PHILPHIL 

  • ceinture noire 1er dan
  • Groupe : Membres
  • Messages : 996
  • Inscrit(e) : 24-janvier 06
  • LocationNANTES

Posté 14 février 2014 - 17:55

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 2019 sous windows 10 64
24 pouces vertical + 30 pouces horizontal + 27 pouces horizontal
0

#7 L'utilisateur est hors-ligne   PHILPHIL 

  • ceinture noire 1er dan
  • Groupe : Membres
  • Messages : 996
  • Inscrit(e) : 24-janvier 06
  • LocationNANTES

Posté 26 avril 2017 - 11:43

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 2019 sous windows 10 64
24 pouces vertical + 30 pouces horizontal + 27 pouces horizontal
0

#8 L'utilisateur est hors-ligne   bonuscad 

  • ceinture rouge et blanche 8em dan
  • Groupe : Membres
  • Messages : 4681
  • Inscrit(e) : 20-juin 03

Posté 26 avril 2017 - 17:04

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
0

Partager ce sujet :


Page 1 sur 1
  • Vous ne pouvez pas commencer un sujet
  • Vous ne pouvez pas répondre à ce sujet

1 utilisateur(s) en train de lire ce sujet
0 membre(s), 1 invité(s), 0 utilisateur(s) anonyme(s)