Bred

Je m'y attendais à celle là... Le truc c'est que je m'en sers comme sous-routine dans un code de plus de 300 lignes, déjà créés il y a quelque temps, et ou je ne traite pas des polyligne mais des lignes... Faudrais pour faire plus propre que je retouche cette partie du code pour lui faire accepter les polylignes, mais là, je suis en phase de test... et je n'ai pas trop le temps.... Merci en tous cas, comme d'habitude, de ton aide et de tes remarques ! J'en prends note.

Re, J'ai "bricolé" ton code, et j'ai fais une routine : Argument : la liste de ligne en vla Retour : Les listes des lignes par formes, la première étant le contour exterieur. But de cette routine : Base : un region quelquonque exploser et dont on a récupérer la liste d'éléments. But : Sortir forme "exterieure" de la region et formes inetrieures afin d'y appliquer des hachures. ;;; Routine pour Trier Region exploser et ressortir ;;; Forme exterieure et FormeS interieures (d'apès code R2PL (gile) CadXP) (defun Tri-li->lstforhatch-Out-In (lstli / AREA AREA-P BLG BLST DLST LSTF OLST PLINE PLST TLST X lst-C LST-C LSTLI N) (defun arcbulge (arc) (/ (sin (/ (vla-get-TotalAngle arc) 4)) (cos (/ (vla-get-TotalAngle arc) 4))) ) (if (vl-every '(lambda (x) (or (= (vla-get-ObjectName x) "AcDbLine") (= (vla-get-ObjectName x) "AcDbArc") (= (vla-get-ObjectName x) "AcDbCircle"))) lstli) (progn ; sort les cercles (mapcar '(lambda (x) (if (= (vla-get-ObjectName x) "AcDbCircle") (setq lst-C (append (list x) lst-C) lstli (vl-remove x lstli)))) lstli) ; création liste ( (# (-7.37653 3.80662 0.0) (-7.37653 6.064 0.0)) (..... (setq olst (mapcar '(lambda (x) (list x (vlax-get x 'StartPoint)(vlax-get x 'EndPoint))) lstli)) (while olst (setq blst nil) (if (= (vla-get-ObjectName (caar olst)) "AcDbArc") (setq blst (list (cons 0 (arcbulge (caar olst)))))) (setq plst (cdar olst) ; 2x coord 1ère ligne dlst (list (caar olst)) ; 1ère ligne olst (cdr olst) ; enlève 1ère ligne de la liste ) ;;; RECUP CONTOUR (while ; tant quej'ai tlst= denière coordonnées 1ère ligne = coordonnées dans olst (setq tlst (vl-member-if '(lambda (x) (or (equal (last plst) (cadr x) 1e-9) (equal (last plst) (caddr x) 1e-9))) olst)) ; si denière coordonnées 1ère ligne = denière coordonnées 1ère ligne dans nouvelle liste (if (equal (last plst) (caddar tlst) 1e-9) (setq blg -1) (setq blg 1) ) (if (= (vla-get-ObjectName (caar tlst)) "AcDbArc") (setq blst (cons (cons (1- (length plst)) (* blg (arcbulge (caar tlst)))) blst))) ; raoute point suivant à plst (setq plst (append plst (if (minusp blg) ; si blg = -1 (list (cadar tlst)) ; 1ère coord 1ère ligne dans nouvelle liste (list (caddar tlst)))) ; 2nde coord 1ère ligne dans nouvelle liste dlst (cons (caar tlst) dlst) ; ligne suivante accepté dans dlst olst (vl-remove (car tlst) olst) ; enlève liste 1ère ligne dans olst ) );FIN récup CONTOUR ; Dessine Polyligne pour récupérer Surface ; (Surface+Grande = Forme Exterieure) (setq pline (vlax-invoke (getspace) 'addLightWeightPolyline (apply 'append (mapcar '(lambda (x) (setq x (trans x 0 Norm)) (list (car x) (cadr x))) (reverse (cdr (reverse plst))))))) (vla-put-Closed pline :vlax-true) (mapcar '(lambda (x) (vla-setBulge pline (car x) (cdr x))) blst) (vla-put-Elevation pline (caddr (trans (car plst) 0 Norm))) (vla-put-Normal pline (vlax-3d-point Norm)) (setq area (vla-get-Area pline)) (if area-p (if (< area-p area) (setq lstF (append (list dlst) lstF)) (setq lstF (append lstF (list dlst))) ) (setq lstF (append (list dlst) lstF)) ) (setq area-p area) (vla-delete pline) ) ;traitement cercles (if lst-C (repeat (setq n (length lst-C)) (setq area (vla-get-Area (nth (setq n (1- n)) lst-C))) (if (< area-p area) (setq lstF (append (list (list (nth n lst-C))) lstF)) (setq lstF (append lstF (list (list (nth n lst-C)))))) (setq area-p area)) ) ) ) lstF ) [Edité le 14/12/2007 par Bred]

Merci (gile) ! je me jette dessus avec plaisir !

Salut, J'ai un problème... qui va faire plaisir à certain... J'explose une region qui a un ou plusieurs "perçage" J'obtiens une liste de ligne... Afin de réaliser le hachurage ( je n'hachure pas les "perçages"), il faut que je détermine quels sont les lignes "exterieures" afin de leur appliquer AppendOuterLoop, et ensuite les formes interieures afin de leur appliquer AppendInnerLoop... et je ne sais pas comment faire... merci d'avance !!!!! [Edité le 13/12/2007 par Bred]

Salut, perso j'ai toujours eu le chemin du fichier ouvert dans la barre de titre... Même en réseau.... Tu as dû avoir une variable qui a sauté (mais je ne sait pas laquelle, désolé...)

Salut Richard-c, Sous 2002 les fonctions visual-lisp ne doivent pas être chargé automatiquement. Il faut donc lui demander de le faire. Il faut rajouter (vl-load-com) en début de code. J'ai modifié les codes ci-dessus en conséquence.

Re, Le calque "defpoint" est sur une calque paramétrer pour ne pas être imprimer. Il est tous à fait possible de paramétrer n'importe queque calque comme ça ! Donc tu peux te créer dans ton gabarit un calque fenêtre que tu spécifie coche l'imprimante dans la colonne "tracer", dans le gestionnaire de calques.

Re, je pense que c'est de mon code que tu veux parler... (et oui, c'est le problème avec plusieurs demande dans un même message ... ;) ) C'est fait, j'ai modifié le code pour qu'un nom de bloc soit demandé (ou par défaut le bloc insérer précedement)

Salut, En bas à droite de la fenêtre Autocad, tu as une petite flèche noir qui va vers le bas, tu vlic dessus et tu peux choisir ce qui apprait dans la barre d'état. Tu verras que tu dois avoir Papier/Objet décoché.

Est-ce que ce lisp de (gile) ne te conviendrais pas ? (Ecrire une demande par post !!!)

Salut, ;;; Remplace Nodal par Bloc demandé (defun c:pt-blc (/ sel i nb) (vl-load-com) (princ "\n Choix des points :") (or (setq sel (ssget '((0 . "POINT")))) (setq sel (ssget "_X" '((0 . "POINT"))))) (setq nb (getstring T (strcat "\n Entrez le nom du bloc <"(getvar "INSNAME")">:"))) (if (equal nb "") (setq nb (getvar "INSNAME"))) (repeat (setq i (sslength sel)) (command "_insert" nb (cdr (assoc 10 (entget (ssname sel (setq i (1- i)))))) 1 1 0) (vla-delete (vlax-ename->vla-object (ssname sel i))) ) (princ (strcat "\n " (rtos (sslength sel)) " Points remplacé par Bloc "(getvar "INSNAME")"")) (princ) ) ;;;Remplace Bloc Selectionné par Nodal (defun c:bloc-pt (/ sel i) (vl-load-com) (princ "\n Choix des Blocs :") (or (setq sel (ssget '((0 . "INSERT")))) (setq sel (ssget "_X" '((0 . "INSERT"))))) (repeat (setq i (sslength sel)) (command "_point" (cdr (assoc 10 (entget (ssname sel (setq i (1- i))))))) (vla-delete (vlax-ename->vla-object (ssname sel i))) ) (princ (strcat "\n " (rtos (sslength sel)) " Blocs remplacé par Point.")) (princ) ) [Edité le 13/12/2007 par Bred]

Salut, Il y a tois choses à prendre en compte : l'echelle de la fenêtre où tu affiches ton carré, l'échelle du tracé (dans la boite de dialogue "impression").... et pour toi, 1 unité représente quel longueur dans le réel... En espace papier l'unité = mm Si 1000 unité = 1000 mm dans le réel. 1:100 de 1000 mm = 10 mm sur le dessin. Extrais de l'aide : Ex : Si ta fenêtre ou tu affiches ton carré est à l'échelle 1, pour imprimer au 1:100 il faut donc que tu paramètres ton echelle de tracé pour que 1mm = 100 unités. Par contre, si la fenêtre où tu affiches ton carré est à l'echelle 1:100, ton carré est donc déjà réduis de 1/100, donc tu dois paramétrer ton echelle de tracé pour que 1 unité = 1mm.

Salut, et Bienvenue sur CadXP !!! Tu devrais plutôt insérer tes photos en images raster et les collers à la dimension sur tes façades. Non, il faut enregister ton plan sous format 2004. (Conseil : plusieurs questions = plusieurs sujets !)

Salut Zebulon, on peut en effet faire ce que tu dits, et c'est d'aileur la finalité je pense de ce challenge. Personnellement j'utilise cette routine : ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; (lst-assoc 10 ent-lwpolyligne) -> tous les sommets de la lwpolyligne; (defun lst-assoc (cle lst) (mapcar 'cdr (vl-remove-if '(lambda (x) (not(equal(car x) cle))) lst)) ) Edit : Je viens de réaliser un Echo à (gile).... Ok, gile, il est vrais que assoc doit certainement passer en revue la liste (c'est bien lent d'ailleurs... :casstet:) [Edité le 11/12/2007 par Bred]

Matt666 : Je penses que ce que tu expliques est plutôt une image des fonctions foreach, ou mapcar avec vl-remove** Pour traiter une liste "wagon par wagon" c'est une méthode évidente pour traiter une liste (malgré que ma fonction récursive ne passe pas en revue tous les éléments de la liste mais "saute" de clef 10 en clef 10.... (gile) : merci, j'ai l'impression que tu expliques en mieux ce que j'essayais de faire comprendre ! Je suis content et je te remercie (encore) : si je commence à y comprendre quelque chose c'est bien grâce aux différentes explication des liens cités plus haut ! [Edité le 11/12/2007 par Bred]

Salut, Et non, tu ne peux pas verrouiller un dwg... En programmation, ça ne peut fonctionner que si la personne qui ouvre le plan à le programme. Je me rappel que Patrick_35 avait réalisé un programme qui faisait cela (pour jalna si je me souvient bien) à base de réacteur, mais si quelqu'un ouvrait le plan sans avoir le programme, la seul chose qui lui arrivait été un message d'erreur....

Salut, moi, j'suis à la bourre, j'en suis toujours à rechercher à créer une fonction récursive pour la première demande (avec dans l'espoir de comprendre la logique).... et je pense que j'aperçois une LED au fond du tunnel... (defun Bred4 (lst / l) (if (assoc 10 lst) (cons (cdr (assoc 10 lst)) (Bred4 (vl-remove (assoc 10 lst) lst))) ) ) ... En fait, si j'ai bien compris le principe de fonctionnement d'une fonction récursive, c'est que "la fonction appelé dans la fonction" retroune le résultat demandé (ici "(vl-remove (assoc 10 lst) lst)"), mais le garde en mémoire (si je peux dire), et donc, si l'on "repasse une fois", cela en faite pourrais dire que je fais "(vl-remove (assoc 10 (vl-remove (assoc 10 lst) lst))(vl-remove (assoc 10 lst) lst))")... etc.... jusqu'à ce que je réponde à la condition d'arrêt.... D'où le terme "d'empilement" ... et le résultat étant "d'ésempilé" au moment où la condition d'arrêt est remplie, pour réaliser le code "(vl-remove (assoc 10 (vl-remove (assoc 10 lst) lst))(vl-remove (assoc 10 lst) lst))")... etc...... d'où le résultat s'empilant "à l'envers".... C'est ça, chef ? :casstet:

C'est vrais que les xdata ce n'est pas trés amusant, mais au moins c'est clair pour moi ! (ça fait 50 fois que je lis ton post explicatif, mais ça m'echappe toujours....) PS : Bien sûr ! merci ! je modifie Bred2 en concéquence ! [Edité le 10/12/2007 par Bred]

Parcours Impressionnant ! Félicitation !

RaaaaaaaaaaAAAAAAAA !!!! (gile).... je te hais !!!!.... ;) moi qui voulais passer une soirée agréable à m'occuper des problèmes de xdata de lili2006... J'en ai bavé... et je suis arrivé enfin à quelque-chose... mais par tatonnement avec des (trace Bred3) (Bred3 lst) Après une bonne centaine de test : (defun Bred3 (lst) (if (assoc 10 lst) (progn (princ (cdr (assoc 10 lst))) (Bred3 (setq lst (vl-remove (assoc 10 lst) lst))) ) ) ) ... et soit gentil, stp !!! (je n'arrive vraiment pas comprendre comment créer ça "logiquement", autrement que par tatonnement....) ... alors que pour moi, ces deux là sont si compréhensibles : (defun Bred1 (lst) (mapcar 'cdr (vl-remove-if '(lambda (x) (not (equal (car x) 10))) lst)) ) (defun Bred2 (lst / l) (While lst (if (equal (car (car lst)) 10) (setq l (append l (list (cdr (car lst)))))) (setq lst (cdr lst)) ) l ) [Edité le 10/12/2007 par Bred]

Salut, Parceque la programmation est un plaisir et un défi ! Et, je n'aime pas ça mais je vais écrire un lieu commun : C'est toujours un plaisir de pouvoir aider des personnes qui semble aussi s'investir pour les autres... J'ai et je reçois aussi beaucoup de beaucoup de personnes dans ce forum que je ne peux aider car mon niveau est trop faible, donc je rends la pareil à d'autre... Ce qu'il y a de marrant aussi, c'est que si j'ai bien compris ta fonction, j'étais à la place de ces étudiants il y a de ça plus d'une dixaine d'année : J'ai passé un Bac F4 (Bâtiment) et ensuite un BTS Bâtiment (et je me suis arrêté là....) :exclam: :P

(defun Marq (f / fonc i) (setq i 0 fonc (list (car f))) (repeat (1- (length f)) (setq fonc (append fonc (list (eval (nth (setq i (1+ i)) f))))) ) (princ (strcat "\nEvaluation de : " (vl-prin1-to-string fonc))) (princ "\n") (eval fonc) )

Oui ! c'est ça, j'avais zapper eval ! Et ce n'est pas ça que tu veux ?

Re, ça ne fonctionne pas (et je ne vois pas la raison), mais c'est un truc du genre : (defun c:test () (Marq '(additionner 2 3)) ) (defun additionner (a b) (+ a b) ) (defun Marq (f / fonc) (foreach n f (setq fonc (append fonc (list n)))) (fonc) )

Salut, (princ (strcat "@macro" a b c)) (attention au type de a b c...