VtKp

Bonjour Voici un petit bout de code qui peut te servir je pense. Il n'est certes pas parfait mais ca marche sur Acad2010. (defun c:imp1 (/ i file pt) (princ "\nEXPORTATION DE POINTS D'IMPLANTATION") (setvar "CMDECHO" 0) (setvar "ATTREQ" 1) (setvar "ATTDIA" 0) (command "SCU" "G") (setvar "INSUNITS" 0) (setvar "OSMODE" 65) (setvar "PDSIZE" 0.5) (setvar "PDMODE" 3) (if (not (tblsearch "LAYER" "PT_IMP")) (command "_layer" "_N" "PT_IMP" "_CO" "3" "PT_IMP" "")) (if (not (tblsearch "LAYER" "NUM_IMP")) (command "_layer" "_N" "NUM_IMP" "_CO" "2" "NUM_IMP" "")) (if (not (tblsearch "STYLE" "Garamond")) (command "-style" "Garamond" "Garamond" 0 1 0 "N" "N")) (setvar "TEXTSTYLE" "Garamond") (setvar "CLAYER" "PT_IMP") (setvar "CECOLOR" "DUCALQUE") (if (not (tblsearch "BLOCK" "PT_IMP")) (progn (entmake '((0 . "BLOCK") (2 . "PT_IMP") (70 . 2) (10 0.0 0.0 0.0))) (entmake '((0 . "ATTDEF") (67 . 0) (8 . "NUM_IMP") (10 1 1 0.0) (40 . 2) (1 . "") (50 . 0.0) (41 . 1.0) (51 . 0.0) (7 . "Garamond") (71 . 0) (72 . 0) (11 0.0 0.0 0.0) (210 0.0 0.0 1.0) (3 . "Matricule") (2 . "MAT") (70 . 0) (73 . 0) (74 . 0) ) ) (entmake '((0 . "POINT") (67 . 0) (8 . "PT_IMP") (10 0.0 0.0 0.0) (50 . 0.0) (210 0.0 0.0 1.0) ) ) (entmake '((0 . "ENDBLK"))) ) ) (setq file (open "C:\\TMP\\IMPLANTATION.txt" "w")) (princ "\nChoisissez les points d'implantation à exporter") (setq i 1) (while (setq pt (getpoint "\nIndiquer le point à implanter <Entrée pour terminer> : ")) (setvar "OSMODE" 0) (command "_.insert" "PT_IMP" pt 1 1 0 (strcat "P" (rtos i 2 0))) (write-line (strcat "P" (rtos i 2 0) "," (rtos (car pt) 2 5) "," (rtos (cadr pt) 2 5) "," (rtos (caddr pt) 2 5)) file) (setq i (1+ i)) (setvar "OSMODE" 65) ) (close file) (command "_.shell" "start notepad C:\\TMP\\IMPLANTATION.txt") (princ (strcat "\n" (itoa (1- i)) " objets exportés")) (setvar "CMDECHO" 1) (prin1) )

Bonjour à tous, Voilà, j'ai pensé à ce bout de code pour améliorer la saisie de fin de tronçon de mon lisp principal. (defun c:pol2 (/ pol ldxf_10 i pth) (setq pol (car (entsel "\nSélectionner la polyligne à traiter : "))) (setq ldxf_10 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget pol)))) (setq i 3) ;; pour exemple pour commencer par le tronçon Est et voir si ca marche (setq pth (sais_tr ldxf_10 i)) (princ pth) (prin1) ) (defun sais_tr (l_pol i / ptn l_tro dl_tro s) (setq l_tro (list "Nord" "Nord-Est" "Est" "Sud-Est" "Sud" "Sud-Ouest" "Ouest" "Nord-Ouest")) (cond ((= i 1) (setq dl_tro "Nord")) ((= i 2) (setq dl_tro "Nord-Est")) ((= i 3) (setq dl_tro "Est")) ((= i 4) (setq dl_tro "Sud-Est")) ((= i 5) (setq dl_tro "Sud")) ((= i 6) (setq dl_tro "Sud-Ouest")) ((= i 7) (setq dl_tro "Ouest")) ((= i 8) (setq dl_tro "Nord-Ouest")) ) (while (/= (car l_tro) dl_tro) (setq l_tro (car2last l_tro)) ) (setq s 0) (while (or (and (setq ptn (getpoint (strcat "\nIndiquer la fin du tronçon " (nth s l_tro) " <ou Suivant> : "))) (not (member (list (car ptn) (cadr ptn)) l_pol)) ) ) (if (= s 8) (setq s 0) (setq s (1+ s))) ) ) (defun car2last (lst) (reverse (cons (car lst) (reverse (cdr lst)))) ) Mais ca ne marche pas comme je veux, En fait, je voudrais pouvoir faire défiler la ligne (setq ptn (getpoint (strcat "\nIndiquer la fin du tronçon " (nth s l_tro) " <ou Suivant> : "))) avec un entrée si la saisie ne correspond pas à l'orientation voulue et avec un contrôle pour savoir si le point sélectionné est ou non sur la polyligne à traiter. Merci par avance de votre aide avant de cloturer ce post..... John

Pas de problème Didier Merci

Bonjour Didier, Merci pour ta réponse, j'ai testé mon lisp sous acad2004, 2008 et 2010. Ca marche très bien Ouvre un nouveau dessin dans Autocad, fais glisser le lisp et lance la commande mitoy et tout se fera normalement si tout va bien. La seule partie de mon code qu'il faudrait je pense modifier correspond à la partie du cond qui permet la sélection de fin de chaque tronçon. Au final, ce sont des coordonnées que je veux comme le fait mon lisp. Le but c'est de comparer des listing de coordonnées sous un autre programme après, voilà tout Merci encore de votre aide. John

Bonjour à tous, Avec un peu de mal et de maux de têtes, voici le lisp qui correspond à ce que je veux faire (à tester dans un dessin vierge et pensez à créer un répertoire intitulé TMP sous C: avant de lancer le lisp) (defun c:mitoy (/ pol ldxf_10 file pti ptd ptn i nb_d nb_f leng pt_ints pt_ind d) (command "_pline" (list 320.36 89.3179) (list 343.404 74.7689) (list 332.727 57.856) (list 314.1233 69.6008) (list 312.485 76.8448) "_c" ) (command "zoom" "et") (setvar "OSMODE" 65) (setq pol (car (entsel "\nChoix de la parcelle à traiter : "))) (setq ldxf_10 (remove-doubles (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget pol))))) (if (not (zerop (logand 1 (cdr (assoc 70 (entget pol)))))) (setq ldxf_10 (append ldxf_10 (list (car ldxf_10)))) ); si poly close, j'ajoute un point (setq file (open "C:/TMP/lim_mitoyenne.txt" "w")) (setq pti (getpoint "\nSélectionner le point de départ : ")) (setq ptd pti) (setq ptn (list (1+ (car pti)) (cadr pti) 0.0)) (setq i 1) (while (and (/= (distance pti ptn) 0) (cond ((= i 1) (or (and (setq ptn (getpoint "\nIndiquer la fin du tronçon Nord")) (setq i 1)) (and (setq ptn (getpoint "\nIndiquer la fin du tronçon Nord-Est")) (setq i 2)) (and (setq ptn (getpoint "\nIndiquer la fin du tronçon Est")) (setq i 3)) (and (setq ptn (getpoint "\nIndiquer la fin du tronçon Sud-Est")) (setq i 4)) (and (setq ptn (getpoint "\nIndiquer la fin du tronçon Sud")) (setq i 5)) (and (setq ptn (getpoint "\nIndiquer la fin du tronçon Sud-Ouest")) (setq i 6)) (and (setq ptn (getpoint "\nIndiquer la fin du tronçon Ouest")) (setq i 7)) (and (setq ptn (getpoint "\nIndiquer la fin du tronçon Nord-Ouest")) (setq i 8)) (and (progn (prompt "\nSaisie non valide") (exit))) ) ) ((= i 2) (or (and (setq ptn (getpoint "\nIndiquer la fin du tronçon Nord-Est")) (setq i 2)) (and (setq ptn (getpoint "\nIndiquer la fin du tronçon Est")) (setq i 3)) (and (setq ptn (getpoint "\nIndiquer la fin du tronçon Sud-Est")) (setq i 4)) (and (setq ptn (getpoint "\nIndiquer la fin du tronçon Sud")) (setq i 5)) (and (setq ptn (getpoint "\nIndiquer la fin du tronçon Sud-Ouest")) (setq i 6)) (and (setq ptn (getpoint "\nIndiquer la fin du tronçon Ouest")) (setq i 7)) (and (setq ptn (getpoint "\nIndiquer la fin du tronçon Nord-Ouest")) (setq i 8)) (and (setq ptn (getpoint "\nIndiquer la fin du tronçon Nord")) (setq i 1)) (and (progn (prompt "\nSaisie non valide") (exit))) ) ) ((= i 3) (or (and (setq ptn (getpoint "\nIndiquer la fin du tronçon Est")) (setq i 3)) (and (setq ptn (getpoint "\nIndiquer la fin du tronçon Sud-Est")) (setq i 4)) (and (setq ptn (getpoint "\nIndiquer la fin du tronçon Sud")) (setq i 5)) (and (setq ptn (getpoint "\nIndiquer la fin du tronçon Sud-Ouest")) (setq i 6)) (and (setq ptn (getpoint "\nIndiquer la fin du tronçon Ouest")) (setq i 7)) (and (setq ptn (getpoint "\nIndiquer la fin du tronçon Nord-Ouest")) (setq i 8)) (and (setq ptn (getpoint "\nIndiquer la fin du tronçon Nord")) (setq i 1)) (and (setq ptn (getpoint "\nIndiquer la fin du tronçon Nord-Est")) (setq i 2)) (and (progn (prompt "\nSaisie non valide") (exit))) ) ) ((= i 4) (or (and (setq ptn (getpoint "\nIndiquer la fin du tronçon Sud-Est")) (setq i 4)) (and (setq ptn (getpoint "\nIndiquer la fin du tronçon Sud")) (setq i 5)) (and (setq ptn (getpoint "\nIndiquer la fin du tronçon Sud-Ouest")) (setq i 6)) (and (setq ptn (getpoint "\nIndiquer la fin du tronçon Ouest")) (setq i 7)) (and (setq ptn (getpoint "\nIndiquer la fin du tronçon Nord-Ouest")) (setq i 8)) (and (setq ptn (getpoint "\nIndiquer la fin du tronçon Nord")) (setq i 1)) (and (setq ptn (getpoint "\nIndiquer la fin du tronçon Nord-Est")) (setq i 2)) (and (setq ptn (getpoint "\nIndiquer la fin du tronçon Est")) (setq i 3)) (and (progn (prompt "\nSaisie non valide") (exit))) ) ) ((= i 5) (or (and (setq ptn (getpoint "\nIndiquer la fin du tronçon Sud")) (setq i 5)) (and (setq ptn (getpoint "\nIndiquer la fin du tronçon Sud-Ouest")) (setq i 6)) (and (setq ptn (getpoint "\nIndiquer la fin du tronçon Ouest")) (setq i 7)) (and (setq ptn (getpoint "\nIndiquer la fin du tronçon Nord-Ouest")) (setq i 8)) (and (setq ptn (getpoint "\nIndiquer la fin du tronçon Nord")) (setq i 1)) (and (setq ptn (getpoint "\nIndiquer la fin du tronçon Nord-Est")) (setq i 2)) (and (setq ptn (getpoint "\nIndiquer la fin du tronçon Est")) (setq i 3)) (and (setq ptn (getpoint "\nIndiquer la fin du tronçon Sud-Est")) (setq i 4)) (and (progn (prompt "\nSaisie non valide") (exit))) ) ) ((= i 6) (or (and (setq ptn (getpoint "\nIndiquer la fin du tronçon Sud-Ouest")) (setq i 6)) (and (setq ptn (getpoint "\nIndiquer la fin du tronçon Ouest")) (setq i 7)) (and (setq ptn (getpoint "\nIndiquer la fin du tronçon Nord-Ouest")) (setq i 8)) (and (setq ptn (getpoint "\nIndiquer la fin du tronçon Nord")) (setq i 1)) (and (setq ptn (getpoint "\nIndiquer la fin du tronçon Nord-Est")) (setq i 2)) (and (setq ptn (getpoint "\nIndiquer la fin du tronçon Est")) (setq i 3)) (and (setq ptn (getpoint "\nIndiquer la fin du tronçon Sud-Est")) (setq i 4)) (and (setq ptn (getpoint "\nIndiquer la fin du tronçon Sud")) (setq i 5)) (and (progn (prompt "\nSaisie non valide") (exit))) ) ) ((= i 7) (or (and (setq ptn (getpoint "\nIndiquer la fin du tronçon Ouest")) (setq i 7)) (and (setq ptn (getpoint "\nIndiquer la fin du tronçon Nord-Ouest")) (setq i 8)) (and (setq ptn (getpoint "\nIndiquer la fin du tronçon Nord")) (setq i 1)) (and (setq ptn (getpoint "\nIndiquer la fin du tronçon Nord-Est")) (setq i 2)) (and (setq ptn (getpoint "\nIndiquer la fin du tronçon Est")) (setq i 3)) (and (setq ptn (getpoint "\nIndiquer la fin du tronçon Sud-Est")) (setq i 4)) (and (setq ptn (getpoint "\nIndiquer la fin du tronçon Sud")) (setq i 5)) (and (setq ptn (getpoint "\nIndiquer la fin du tronçon Sud-Ouest")) (setq i 6)) (and (progn (prompt "\nSaisie non valide") (exit))) ) ) ((= i 8) (or (and (setq ptn (getpoint "\nIndiquer la fin du tronçon Nord-Ouest")) (setq i 8)) (and (setq ptn (getpoint "\nIndiquer la fin du tronçon Nord")) (setq i 1)) (and (setq ptn (getpoint "\nIndiquer la fin du tronçon Nord-Est")) (setq i 2)) (and (setq ptn (getpoint "\nIndiquer la fin du tronçon Est")) (setq i 3)) (and (setq ptn (getpoint "\nIndiquer la fin du tronçon Sud-Est")) (setq i 4)) (and (setq ptn (getpoint "\nIndiquer la fin du tronçon Sud")) (setq i 5)) (and (setq ptn (getpoint "\nIndiquer la fin du tronçon Sud-Ouest")) (setq i 6)) (and (setq ptn (getpoint "\nIndiquer la fin du tronçon Ouest")) (setq i 7)) (and (progn (prompt "\nSaisie non valide") (exit))) ) ) ) ) (setq nb_d (vl-position (reverse (cdr (reverse ptd))) ldxf_10)) (setq nb_f (vl-position (reverse (cdr (reverse ptn))) ldxf_10)) (setq leng (- nb_f nb_d)) (setq pt_ints (sublst ldxf_10 (1+ nb_d) (1+ leng))) (cond ((= i 1) (write-line "Tronçon Nord : " file) (setq d 0) (repeat (length pt_ints) (setq pt_ind (nth d pt_ints)) (write-line (strcat "Point " (itoa (1+ (vl-position pt_ind ldxf_10))) "\t" "-" "\t" (rtos (car pt_ind) 2 2) "\t" (rtos (cadr pt_ind) 2 2)) file) (setq d (1+ d)) ) ) ((= i 2) (write-line "Tronçon Nord-Est : " file) (setq d 0) (repeat (length pt_ints) (setq pt_ind (nth d pt_ints)) (write-line (strcat "Point " (itoa (1+ (vl-position pt_ind ldxf_10))) "\t" "-" "\t" (rtos (car pt_ind) 2 2) "\t" (rtos (cadr pt_ind) 2 2)) file) (setq d (1+ d)) ) ) ((= i 3) (write-line "Tronçon Est : " file) (setq d 0) (repeat (length pt_ints) (setq pt_ind (nth d pt_ints)) (write-line (strcat "Point " (itoa (1+ (vl-position pt_ind ldxf_10))) "\t" "-" "\t" (rtos (car pt_ind) 2 2) "\t" (rtos (cadr pt_ind) 2 2)) file) (setq d (1+ d)) ) ) ((= i 4) (write-line "Tronçon Sud-Est : " file) (setq d 0) (repeat (length pt_ints) (setq pt_ind (nth d pt_ints)) (write-line (strcat "Point " (itoa (1+ (vl-position pt_ind ldxf_10))) "\t" "-" "\t" (rtos (car pt_ind) 2 2) "\t" (rtos (cadr pt_ind) 2 2)) file) (setq d (1+ d)) ) ) ((= i 5) (write-line "Tronçon Sud : " file) (setq d 0) (repeat (length pt_ints) (setq pt_ind (nth d pt_ints)) (write-line (strcat "Point " (itoa (1+ (vl-position pt_ind ldxf_10))) "\t" "-" "\t" (rtos (car pt_ind) 2 2) "\t" (rtos (cadr pt_ind) 2 2)) file) (setq d (1+ d)) ) ) ((= i 6) (write-line "Tronçon Sud-Ouest : " file) (setq d 0) (repeat (length pt_ints) (setq pt_ind (nth d pt_ints)) (write-line (strcat "Point " (itoa (1+ (vl-position pt_ind ldxf_10))) "\t" "-" "\t" (rtos (car pt_ind) 2 2) "\t" (rtos (cadr pt_ind) 2 2)) file) (setq d (1+ d)) ) ) ((= i 7) (write-line "Tronçon Ouest : " file) (setq d 0) (repeat (length pt_ints) (setq pt_ind (nth d pt_ints)) (write-line (strcat "Point " (itoa (1+ (vl-position pt_ind ldxf_10))) "\t" "-" "\t" (rtos (car pt_ind) 2 2) "\t" (rtos (cadr pt_ind) 2 2)) file) (setq d (1+ d)) ) ) ((= i 8) (write-line "Tronçon Nord-Ouest : " file) (setq d 0) (repeat (length pt_ints) (setq pt_ind (nth d pt_ints)) (write-line (strcat "Point " (itoa (1+ (vl-position pt_ind ldxf_10))) "\t" "-" "\t" (rtos (car pt_ind) 2 2) "\t" (rtos (cadr pt_ind) 2 2)) file) (setq d (1+ d)) ) ) ) (write-line "\n" file) (setq ptd ptn) (setq i (1+ i)) ) (close file) (if (= (distance pti ptn) 0) (command "_.shell" "start notepad C:\\TMP\\lim_mitoyenne.txt") ) (prin1) ) (defun remove-doubles (lst / lst2) (while (car lst) (setq lst2 (cons (car lst) lst2) lst (vl-remove (car lst) lst) ) ) (reverse lst2) ) (defun sublst (lst start leng / rslt) (if (not (<= 1 leng (- (length lst) start))) (setq leng (- (length lst) (1- start))) ) (repeat leng (setq rslt (cons (nth (1- start) lst) rslt) start (1+ start) ) ) (reverse rslt) ) le cond qui permet la sélection de fin de chaque tronçon correspond à la partie que je souhaiterais simplifier car elle me semble trop longue et pas adéquat. Si vous avez des idées sinon c'est pas grave. Merci encore de votre aide. John

Bonjour Didier, Bonuscad Didier, il s'agit en fait d'identifier des points communs sur une limite mitoyenne entre deux parcelles. dans le cadre d'un document d'arpentage sur Mayotte. Bonuscad, je ne vois pas bien l'interêt d'une telle commande si ce n'est enfin pour ma part l'utilisation de grdraw. Merci encore pour votre aide. John

oK Pas de problème pour le message. Pour mon problème, le tronçon Nord correspond à un ou plusieurs segments de la polyligne 2D fermée orienté au Nord quand tu mets le curseur Autocad au centre de la parcelle. Tu prends le cas d'un carré par exemple, tu as bien si tu mets ton curseur au centre de ce carré en tournant dans le sens horaire 4 orientations, une au Nord, une à l'est, une au Sud et une à l'Ouest. Dans mon cas si tu prends ce même carré, je voudrais faire une boucle qui à partir d'un point sélectionné (point en haut à gauche dans cet exemple) le lisp demande à l'utilisateur la fin du tronçon Nord (l'utilisateur sélectionnerait le point haut droit et on aurait une liste l_onr du type Nord - (les coordonnées du point haut gauche) (coordonnées des points intermédiaires s'il y en a) (coordonnées du point haut droit) , puis on continue avec la fin du tronçon Est, Est - (les coordonnées du point haut droit) (coordonnées des points intermédiaires s'il y en a) (coordonnées du point bas droit) , puis on continue avec la fin du tronçon Sud, Sud - (les coordonnées du point bas droit) (coordonnées des points intermédiaires s'il y en a) (coordonnées du point bas gauche) , puis on continue avec la fin du tronçon Ouest, Ouest - (les coordonnées du point bas gauche) (coordonnées des points intermédiaires s'il y en a) (coordonnées du point haut gauche) Et comme le point de fin du tronçon Ouest correspond au point de début du tronçon Nord, la boucle s'arrête. D'ou la necessité de sélectionner un point de départ et de terminer la boucle sur ce même point départ quand l'utlisation clique le même point. La liste l_onr contiendrait ainsi 4 tronçons avec tous les coordonnées des sommets chaque orientation. Par contre, si au lieu des coordonnées des points de début, intermédiaires et de fin de chaque tronçon on pourrait stocker les listes des segments obtenues avec la fonction getPolySegs, c'est mieux sinon avec les coordonnées, je pourrais m'en sortir. Et de même si on pourrait intégrer dans le choix de sélection des tronçons des intermédiaires comme Nord-Ouest, Nord-Est, Sud-Ouest, Sud-Est ce serait super mais bon je verrais cela après .... Merci encore de ton aide. John

Bonjour Tramber Merci de ta réponse et désolé de "polluer" ce post ou ce forum. Tu peux changer ce post de sous forum si tu le désires, pas de problème. J'ai testé ton bout de code et je n'arrive pas à ce que je veux. Le but est d'écrire dans un fichier texte suivant les différentes orientations choisies par l'utilisateur les coordonnées des sommets d'un ou de plusieurs segments d'un tronçon Nord, Sud, ou encore Nord-Ouest comme indiqué ici dans cet exemple ;; Début de la boucle à réaliser ;; L'utilisateur indique le premier point du tronçon Nord, ;; Avec la liste l_seg, on sauvegarde dans une liste le segment ou la continuite de deux segments correspondant au Nord. ;; Dans notre cas, on aurait une liste du type (que pour l'orientation Nord) ;; l_onr (("Nord" (((150.0 150.0) 0.0 (135.0 145.0)) ((135.0 145.0) 0.0 (125.0 158.0))))) ;; Ensuite sélection de la fin du tronçon Est, on aurait donc une liste du type ;; l_onr ( ;; ("Nord" (((150.0 150.0) 0.0 (135.0 145.0)) ((135.0 145.0) 0.0 (125.0 158.0)))) ;; ("Est" ((150.0 130.0) 0.0 (150.0 150.0))) ;; ) ;; Ensuite sélection de la fin du tronçon Sud, on aurait donc une liste du type ;; l_onr ( ;; ("Nord" (((150.0 150.0) 0.0 (135.0 145.0)) ((135.0 145.0) 0.0 (125.0 158.0)))) ;; ("Est" ((150.0 130.0) 0.0 (150.0 150.0))) ;; ("Sud" (((125.0 125.0) 0.0 (135.0 120.0)) ((135.0 120.0) 0.0 (150.0 130.0)))) ;; ) ;; Et pour finir, sélection de la fin du tronçon Ouest et la boucle doit se terminer car le point sélectionné au départ et le même que celui d'arrivée ;; l_onr ( ;; ("Nord" (((150.0 150.0) 0.0 (135.0 145.0)) ((135.0 145.0) 0.0 (125.0 158.0)))) ;; ("Est" ((150.0 130.0) 0.0 (150.0 150.0))) ;; ("Sud" (((125.0 125.0) 0.0 (135.0 120.0)) ((135.0 120.0) 0.0 (150.0 130.0)))) ;; ("Ouest" ((125.0 158.0) 0.0 (125.0 125.0))) ;; ) Et en utilisant si possible cette méthode de saisie (setq ptn (getpoint "\nIndiquer la fin du tronçon Nord")) (setq ptn (getpoint "\nIndiquer la fin du tronçon Nord-Est")) (setq ptn (getpoint "\nIndiquer la fin du tronçon Est")) (setq ptn (getpoint "\nIndiquer la fin du tronçon Sud-Est")) (setq ptn (getpoint "\nIndiquer la fin du tronçon Sud")) (setq ptn (getpoint "\nIndiquer la fin du tronçon Sud-Ouest")) (setq ptn (getpoint "\nIndiquer la fin du tronçon Ouest")) (setq ptn (getpoint "\nIndiquer la fin du tronçon Nord-Ouest")) En récapitulant après la saisie du point de départ, l'utilisateur doit indiquer la fin du tronçon Nord et toutes les coordonnées des sommets du tronçon Nord doivent être ajoutés à la liste l_onr, Ensuite le lisp continue avec la saisie de la fin du tronçon Est, toutes les coordonnées des sommets du tronçon Est doivent être ajoutés à la liste l_onr, ... ETC jusqu'à arrivé au tronçon Nord-Ouest La boucle s'arrête si l'utilisateur sélectionne un point d'arrivée qui est le même que le point de départ défini comme pti Après la sélection de la fin d'un tronçon (par exemple Nord) , mon problème vient du fait que je ne sais comment proposer à l'utilisateur de reprendre la sélection avec la fin du tronçon Est par exemple et non pas de reprendre la boucle depuis le début. Je pense qu'il faut utiliser les fonctions grread et grdraw mais j'ai du mal à les comprendre. J'espère que mes explications t'auront éclairé. Merci encore de ton aide. John les coor

Voici à peu près ce que j'aimerais faire Bout de code à mettre à la suite de (setq pti (getpoint "\nSélectionner le point de départ : ")) (setq l_onr nil) (while (and (or (setq ptn (getpoint "\nIndiquer la fin du tronçon Nord")) (setq ptn (getpoint "\nIndiquer la fin du tronçon Nord-Est")) (setq ptn (getpoint "\nIndiquer la fin du tronçon Est")) (setq ptn (getpoint "\nIndiquer la fin du tronçon Sud-Est")) (setq ptn (getpoint "\nIndiquer la fin du tronçon Sud")) (setq ptn (getpoint "\nIndiquer la fin du tronçon Sud-Ouest")) (setq ptn (getpoint "\nIndiquer la fin du tronçon Ouest")) (setq ptn (getpoint "\nIndiquer la fin du tronçon Nord-Ouest")) ) (/= (distance pti ptn) 0) ) ;; Il faudrait là enregistrer les segments dans la liste l_onr et reprendre la définition des orientations depuis la dernière arreté et non pas depuis le début. ;; Par exemple si on clique sur le 3ième sommet de la parcelle, reprendre à la fin du Tronçon Sud et non pas au Nord ;; mais je patine avec le peu de connaissances que j'ai (command "_pline" pti ptn "") (setq ptn pti) ) Merci par avance de votre aide John

Bonjour, Voici un lisp explicite je pense de ma demande A tester dans un dessin vierge (defun c:pol1 (/ file pol ldxf_10 lseg) ;; Création d'une parcelle exemple (setvar "CECOLOR" "1") (command "_pline" (list 125 125 0) (list 135 120 0) (list 150 130 0) (list 150 150 0) (list 135 145 0) (list 125 158 0) "c" ) (setvar "CECOLOR" "DUCALQUE") ;; Zoom centré (command "zoom" "et") ;; Création du fichier Export (setq file (open "C:\\Export_poly.txt" "w")) (setq pol (car (entsel "\nChoix de la parcelle à traiter : "))) (setq ldxf_10 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget pol)))) (setq lseg (GetPolySegs pol)) (setq pti (getpoint "\nSélectionner le point de départ : ")) (setq ptn (getpoint "\nIndiquer la fin du tronçon - Point suivant : ")) ;; Début de la boucle à réaliser ;; L'utilisateur indique le premier point du tronçon Nord, ;; Avec la liste l_seg, on sauvegarde dans une liste le segment ou la continuite de deux segments correspondant au Nord. ;; Dans notre cas, on aurait une liste du type (que pour l'orientation Nord) ;; l_onr (("Nord" (((150.0 150.0) 0.0 (135.0 145.0)) ((135.0 145.0) 0.0 (125.0 158.0))))) ;; Ensuite sélection de la fin du tronçon Est, on aurait donc une liste du type ;; l_onr ( ;; ("Nord" (((150.0 150.0) 0.0 (135.0 145.0)) ((135.0 145.0) 0.0 (125.0 158.0)))) ;; ("Est" ((150.0 130.0) 0.0 (150.0 150.0))) ;; ) ;; Ensuite sélection de la fin du tronçon Sud, on aurait donc une liste du type ;; l_onr ( ;; ("Nord" (((150.0 150.0) 0.0 (135.0 145.0)) ((135.0 145.0) 0.0 (125.0 158.0)))) ;; ("Est" ((150.0 130.0) 0.0 (150.0 150.0))) ;; ("Sud" (((125.0 125.0) 0.0 (135.0 120.0)) ((135.0 120.0) 0.0 (150.0 130.0)))) ;; ) ;; Et pour finir, sélection de la fin du tronçon Ouest et la boucle doit se terminer car le point sélectionné au départ et le même que celui d'arrivée ;; l_onr ( ;; ("Nord" (((150.0 150.0) 0.0 (135.0 145.0)) ((135.0 145.0) 0.0 (125.0 158.0)))) ;; ("Est" ((150.0 130.0) 0.0 (150.0 150.0))) ;; ("Sud" (((125.0 125.0) 0.0 (135.0 120.0)) ((135.0 120.0) 0.0 (150.0 130.0)))) ;; ("Ouest" ((125.0 158.0) 0.0 (125.0 125.0))) ;; ) ;; Voici un début de boucle mais incomplet à mon sens, il doit manquer certaines conditions ;; et surtout je ne vois pas comment indiquer dans une boucle de ce type le choix entre une orientation Nord, Est, Sud et Ouest ;;(while (/= (distance (pti ptn)) 0)) (write-line "Au Nord : (((150.0 150.0) 0.0 (135.0 145.0)) ((135.0 145.0) 0.0 (125.0 158.0)))" file) (close file) (command "_.shell" "start notepad C:\\Export_poly.txt") (princ ldxf_10) (prin1) ) ;;(cond ;;(x_alpha ;;(entmod (subst (cons 50 x_alpha) (assoc 50 dxf_txt) dxf_txt)) ;;(princ "\n<Espace> ou [Click+gauche] pour tourner de 90°/<Entrée> ou [Click+droit] pour finir!.") ;;(while (and (not (member (setq key (grread nil 4 0)) '((2 13)))) (/= (car key) 25)) ;;(setq x_alpha (+ (/ pi 2.0) x_alpha)) ;;(entmod (subst (cons 50 x_alpha) (assoc 50 dxf_txt) dxf_txt)) ;;) ;;(redraw) ;;) ;;) (defun getPolySegs (ent / entl p1 pt bulge seg ptlst) (cond (ent (setq entl (entget ent)) ;; save start point if polyline is closed (if (= (logand (cdr (assoc 70 entl)) 1) 1) (setq p1 (cdr (assoc 10 entl))) ) ;; run thru entity list to collect list of segments (while (setq entl (member (assoc 10 entl) entl)) ;; if segment then add to list (if (and pt bulge) (setq seg (list pt bulge)) ) ;; save next point and bulge (setq pt (cdr (assoc 10 entl)) bulge (cdr (assoc 42 entl)) ) ;; if segment is build then add last point to segment ;; and add segment to list (if seg (setq seg (append seg (list pt)) ptlst (cons seg ptlst)) ) ;; reduce list and clear temporary segment (setq entl (cdr entl) seg nil ) ) ) ) ;; if polyline is closed then add closing segment to list (if p1 (setq ptlst (cons (list pt bulge p1) ptlst))) ;; reverse and return list of segments (reverse ptlst) ) (defun getArcInfo (segment / a p1 bulge p2 c p3 p4 p r s result) ;; assigner variables avec les valeurs de l'argument (mapcar 'set '(p1 bulge p2) segment) (if (not (zerop bulge)) (progn ;; trouver la corde (setq c (distance p1 p2)) ;; trouver la flèche (setq s (* (/ c 2.0) (abs bulge))) ;; trouver le rayon par Pythagore (setq r (/ (+ (expt s 2.0) (expt (/ c 2.0) 2.0)) (* 2.0 s))) ;; distance au centre (setq a (- r s)) ;; coordonnées du milieu de p1 et P2 (setq P4 (polar P1 (angle P1 P2) (/ c 2.0))) ;; coordonnées du centre (setq p (if (>= bulge 0) (polar p4 (+ (angle p1 p2) (/ pi 2.0)) a) (polar p4 (- (angle p1 p2) (/ pi 2.0)) a) ) ) ;; coordonnées de P3 (setq p3 (if (>= bulge 0) (polar p4 (- (angle p1 p2) (/ pi 2.0)) s) (polar p4 (+ (angle p1 p2) (/ pi 2.0)) s) ) ) (setq result (list p r c)) ) (setq result nil) ) result ) (defun clockwise-p (p1 p2 p3) (< (sin (- (angle p1 p3) (angle p1 p2))) -1e-14) ) (defun remove-doubles (lst / lst2) (while (car lst) (setq lst2 (cons (car lst) lst2) lst (vl-remove (car lst) lst) ) ) (reverse lst2) ) (defun ang2d (p1 p2 p3 / base ang) (setq base (getvar "ANGBASE")) (setq ang (abs (- (angle p2 p1) (angle p2 p3)))) (if (< (+ pi 1e-9) ang) (setq ang (- (* 2 pi) ang)) ) (if (zerop (getvar "ANGDIR")) (+ base ang) (- base ang) ) ) (prin1)

Désolé de ne pas avoir répondu plus tôt mais j'étais en déplacement Merci Patrick pour tes réponses, j'ai pu m'en sortir. Je pense que l'on peut cloturer ce post Merci encore à vous tous John

Bonjour à tous, Avant de cloturer ce post, dernière petite question Comment fait-on pour centré du texte ou bien le placer à gauche ou à droite de la page Word ? J'ai recherché dans tous les fonctions Font, Border et Style avec (vlax-dump-object wsel) ou encore (vlax-dump-object wtxt) mais je n'ai rien trouvé. Merci par avance de votre aide John

Ok Merci sérieusement pour votre aide à tous John

Bonjour à tous, Je dois faire pour me simplifier la saisie manuelle une routine lisp qui permet d'écrire des données Autocad dans un document Word. J'ai trouvé mon besoin avec des commandes comme ;; récupérer un nom de fichier (setq filename (getfiled "Créer un fichier Word" "" "doc" 1)) ;; obtenir ou créer une intance de l'application (setq wapp (vlax-get-or-create-object "Word.Application")) ;; obtenir les documents (setq wdocs (vlax-get-property wapp 'Documents)) ;; créer un nouveau document (setq wdoc (vlax-invoke-method wdocs 'Add)) ;; obtenir la sélection (ou le curseur) (setq wsel (vlax-get-property wapp 'Selection)) ;; Entrer du texte (vlax-invoke-method wsel 'TypeText "Ceci est un test") ;; sauver le fichier (vlax-invoke-method wdoc 'SaveAs filename) ;; fermer le document (vlax-invoke-method wdoc 'Close) ;; quitter l'application (vlax-invoke-method wapp 'Quit) ;; supprimer l'instance et nettoyer la mémoire (indispensable) (vlax-release-object wapp) (gc) Il ne manque seulement que des lignes de codes pour paramétrer le style de texte et l'écriture en gras en italique, et la hauteur de texte Je sais qu'avec les composants VBA COM, ca peut se faire mais je cherche depuis 3 jours en vain avec par exemple pour mettre en gras (vlax-get-property wsel 'Font.Bold 1) (vlax-put-property wsel 'Font.Bold True) Si quelqu'un pourrait m'aider, Merci par avance. John

Merci Tramber pour ton aide. Ca marche très bien John