KHdA Posté(e) le 4 novembre 2005 Partager Posté(e) le 4 novembre 2005 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 More sharing options...
bonuscad Posté(e) le 4 novembre 2005 Partager Posté(e) le 4 novembre 2005 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 More sharing options...
didier Posté(e) le 5 novembre 2005 Partager Posté(e) le 5 novembre 2005 BonjourSalut à Toi, Ô BonusCad je te propose le même type d'ébauche de réflexionmais en VBA,à toi de choisir le plus proche de tes affinités Sub TestArrondir()Dim ObjLigne1 As AcadLineDim ObjLigne2 As AcadLineDim PD(0 To 2) As DoubleDim 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.DeleteSet ObjLigne2 = ThisDrawing.ModelSpace.AddLine(PD, PA) End Sub amicalement Éternel débutant... Mon site perso : Programmer dans AutoCAD Lien vers le commentaire Partager sur d’autres sites More sharing options...
bonuscad Posté(e) le 6 novembre 2005 Partager Posté(e) le 6 novembre 2005 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 More sharing options...
KHdA Posté(e) le 7 novembre 2005 Auteur Partager Posté(e) le 7 novembre 2005 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 More sharing options...
PHILPHIL Posté(e) le 14 février 2014 Partager Posté(e) le 14 février 2014 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 More sharing options...
PHILPHIL Posté(e) le 26 avril 2017 Partager Posté(e) le 26 avril 2017 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 More sharing options...
bonuscad Posté(e) le 26 avril 2017 Partager Posté(e) le 26 avril 2017 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 More sharing options...
Messages recommandés
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 compteSe connecter
Vous avez déjà un compte ? Connectez-vous ici.
Connectez-vous maintenant