chris_mtp

Merci Bonuscad pour cette fonction. En effet, ca peut aider l'utilisateur. Par contre rein a faire pour modifier mon bout de code lisp et simplifier la saisie de fin des troncons sinon c pas grave Je laisse ca comme ca tant Que ca march Merci encore de ton aide John

Bonjour Didier Pour répondre a tes questions, Oui j'ai vu ta vidéo, pas mal mais le mode de sélection ne convient pas imagine une parcelle avec 60 segments pour un tronçon, selectionner les 60 segments les uns après les autres serait une source d'erreur et fastidieux D'ou Je pense la simplicite de selectionner Que la fin de chaque troncon Chris-mtp et Vtkp correspond a la meme personne, j'utilise 2 pseudo car J'ai DES soucis pour me connecter a partir de plusieurs non pas en meme temps Mais a partir de mon bureau ou chez moi Quant au format des donnees, il faut exporter les Coordonnees comme mon lisp example Je pense Que la function grtext ou grread peut simplifier Le mode de selection Mais la ca depasse mes connaissances J'ai modifie Le chemin d'export des donnees, ca devrait marcher maintenant sans problem. Merci pour ton aide, en Esperant t'avoir eclaire John

Teste le au moins tout y est dedans

Bonjour a tous Je dois dans un lisp utiliser june fonction du type grread ou grdraw qui me permettrait de définir les orientations d'une parcelle. Je m'explique : Prenons un carre de 10 sur 10. Une partie est oriente au Nord, une a L'est, au sud et a l'ouest. Comment je peux faire une boucle (qui s'arreterait si l'utilisateur arrive sur le meme point de depart et d'arrivee) avec 4 entree par exemple avec la fonction getpoint pour dire que tel ou tel segment est au Nord, Sud Est ou Ouest ? Je dois en fait creer pour chaque parcelle un fichier texte avec les coordonnées de chaque extrémités de tous les segments qui composent la polyligne 2D close.. Par exemple : - Au Nord : pt1 x1 y1 pt2 x2 y2 - A l'Est : pt2 x2 y2 pt3 x3 y3 - Au Sud : pt3 x3 y3 pt4 x4 y4 - A l'Ouest : pt4 x4 y4 pt1 x1 y1 Je pense qu'il faudrait utiliser les fonctions grread, grtext ou grdraw mais ça dépasse de loin mes connaissances en visual lisp. Car il faudrait qu'en sélectionnant la polyligne2d, la parcelle en fait que le lisp retrace par dessus une même polyligne qui permettrait a l'utilisateur de voir concrètement les orientations qu'il définit. Avez vous des idées pour m'éclairer ? Merci par avance de votre aide. John

Bonjour à tous, Ce sujet m'interresse énormément car je suis dans la même problématique que harksin à savoir devoir protéger mes ressources mais tout le monde au bureau doit pouvoir y accéder. Peut être est ce une question bête mais peut on compiler tous ces lisp, menu et autres dans une Dll et appeler cette dll via la commande netload ? Ainsi, un utilisateur lambda ne pourrait pas voir le code proprement dit ni le copier coller sur n'importe quel support (disque, clé USB) pour l'installer sur une autre machine par exemple. Merci par avance de vos réponses.

Merci pour vos tests. Cette routine marche donc sur toutes les versions d'Autocad apparemement. En attendant d'autres testeurs avec indication de la version d'Autocad utiilisé Par contre, pour la demande de VtKp, je ne sais pas comment faire un carroyage à partir de mon cadre. Si quelqu"un pourrait me donner une piste ou un début de code car la je bloque Lecrabe, merci d'avoir testé cette routine Oui c'est pour la présentation Oui car c'est pour éventuellement retracer la fmult à la main avec une autre échelleou zoomer sur une autre zone Oui car sinon il faudrait quand même la présentation pour l'ajuster selon les marges d'impression Mais comme dit plus haut, ce code peut être addapté. Le but pour moi là est de savoir s'il marche et si on peut comme le suggère VtKp faire un carroyage directement selon l'échelle Merci encore de vos réponses et de votre aide John

Bonjour à tous, Heureux que lecrabe ait pu trouver ce qu'il lui faut Je vais analyser le code en détail John

Bonjour Lecrabe, Voici un code très succint qui ne traite que les polylignes 2D. La sélection est à adapter mais ca peut servir comme base de travail. Le bloc est crée automatiquement. (defun c:npol (/ ss1 i pol pt) (prompt "\nGénération de blocs sur formes closes") (vl-load-com) (setvar "CMDECHO" 0) (setvar "OSMODE" 0) (command "SCU" "G") (setvar "ATTDIA" 0) (setvar "ATTREQ" 1) (if (not (tblsearch "LAYER" "BL_POLYLINE")) (command "_layer" "_N" "BL_POLYLINE" "_CO" "7" "BL_POLYLINE" "")) (setvar "CLAYER" "BL_POLYLINE") (if (not (tblsearch "BLOCK" "BL_POLYLINE")) (progn (alert "Le bloc BL_POLYLINE n'existe pas") (entmake '((0 . "BLOCK") (2 . "BL_POLYLINE") (70 . 2) (10 0.0 0.0 0.0))) (entmake '((0 . "ATTDEF") (67 . 0) (8 . "0") (10 0.4 0.575482 0.0) (40 . 1.0) (1 . "BL_1") (50 . 0.0) (41 . 1.0) (51 . 0.0) (7 . "Standard") (210 0.0 0.0 1.0) (3 . "Numéro Polyligne ? ") (2 . "NUM_POLYLIN") (70 . 0) ) ) (entmake '((0 . "CIRCLE") (67 . 0) (8 . "0") (10 0.0 0.0 0.0) (40 . 0.2) (210 0.0 0.0 1.0) ) ) (entmake '((0 . "ENDBLK"))) ) ) (setq ss1 (ssget "_X" (list (cons 8 "LIMPAR") (cons 0 "LWPOLYLINE") (cons -4 "(cons -4 "&") (cons 70 1) (cons -4 "<") (cons 70 8) (cons -4 "AND>") ))) (setq i 0) (repeat (sslength ss1) (setq pol (ssname ss1 i)) (setq pt (pline-centroid pol)) (command "_.insert" "BL_POLYLINE" pt 1 1 0 (strcat "BL_" (rtos (1+ i) 2 0))) (setq i (1+ i)) ) (prompt (strcat "\n" (itoa i) " blocs insérés.")) (setvar "OSMODE" 65) (setvar "CMDECHO" 1) (command "SCU" "PR") (setvar "ATTDIA" 1) (prin1) ) ;; PLINE-CENTROID ;; Retourne le centre de gravité d'une polyligne (coordonnées SCG) ;; ;; Argument ;; pl : nom d'entité de la polyligne (ename) (defun pline-centroid (pl / elst lst tot cen p0 p-c cen area) (setq elst (entget pl)) (while (setq elst (member (assoc 10 elst) elst)) (setq lst (cons (cons (cdar elst) (cdr (assoc 42 elst))) lst) elst (cdr elst) ) ) (setq lst (reverse lst) tot 0.0 cen '(0.0 0.0) p0 (caar lst) ) (if (/= 0 (cdar lst)) (setq p-c (polyarc-centroid (cdar lst) p0 (caadr lst)) cen (mapcar '(lambda (x) (* x (cadr p-c))) (car p-c)) tot (cadr p-c) ) ) (setq lst (cdr lst)) (if (equal (car (last lst)) p0 1e-9) (setq lst (reverse (cdr (reverse lst)))) ) (while (cadr lst) (setq area (algeb-area p0 (caar lst) (caadr lst)) cen (mapcar '(lambda (x1 x2) (+ x1 (* x2 area))) cen (triangle-centroid p0 (caar lst) (caadr lst)) ) tot (+ area tot) ) (if (/= 0 (cdar lst)) (setq p-c (polyarc-centroid (cdar lst) (caar lst) (caadr lst)) cen (mapcar '(lambda (x1 x2) (+ x1 (* x2 (cadr p-c)))) cen (car p-c) ) tot (+ tot (cadr p-c)) ) ) (setq lst (cdr lst)) ) (if (/= 0 (cdar lst)) (setq p-c (polyarc-centroid (cdar lst) (caar lst) p0) cen (mapcar '(lambda (x1 x2) (+ x1 (* x2 (cadr p-c)))) cen (car p-c) ) tot (+ tot (cadr p-c)) ) ) (trans (list (/ (car cen) tot) (/ (cadr cen) tot) (cdr (assoc 38 (entget pl))) ) pl 0 ) ) ;; ALGEB-AREA ;; Retourne l'aire algébrique du triangle défini par 3 points 2D ;; l'aire est négative si les points sont en sens horaire (defun algeb-area (p1 p2 p3) (/ (- (* (- (car p2) (car p1)) (- (cadr p3) (cadr p1)) ) (* (- (car p3) (car p1)) (- (cadr p2) (cadr p1)) ) ) 2.0 ) ) ;; TRIANGLE-CENTROID ;; Retourne le centre de gravité d'un trinagle défini par 3 points (defun triangle-centroid (p1 p2 p3) (mapcar '(lambda (x1 x2 x3) (/ (+ x1 x2 x3) 3.0) ) p1 p2 p3 ) ) ;; POLYARC-CENTROID ;; Retourne une liste dont le premier élément est le centre de gravité du polyarc ;; et le second son aire algébrique (négative si la courbure est en sens horaire) ;; ;; Arguments ;; bu : la courbure du polyarc (bulge) ;; p1 : le sommet de départ ;; p2 : le sommet de fin (defun polyarc-centroid (bu p1 p2 / ang rad cen area dist cg) (setq ang (* 2 (atan bu)) rad (/ (distance p1 p2) (* 2 (sin ang)) ) cen (polar p1 (+ (angle p1 p2) (- (/ pi 2) ang)) rad ) area (/ (* rad rad (- (* 2 ang) (sin (* 2 ang)))) 2.0) dist (/ (expt (distance p1 p2) 3) (* 12 area)) cg (polar cen (- (angle p1 p2) (/ pi 2)) dist ) ) (list cg area) ) J'utilise 3 fonctions de Gile. John

Bonjour à tous Suite à ce sujet http:// http://www.cadxp.com/sujetXForum-31560.htm et dans le cadre d 'un besoin ponctuel dans mon travail, j'ai fais cette routine qui permet de réaliser une présentation selon divers paramètres utilisateur. J'attends vos remarques éventuelles pour améliorer, modifier et enrichir ce code qui je crois est loin d'être parfait. Peut être sera t--elle utile pour des utilisateurs d'Autocad à voir ou à adapter selon les besoins. (defun c:fm1 (/ lst1 pt1 echl lst_pr nom_pr1) (prompt "\nCréation Fenêtre Espace Papier Automatisée") (vl-load-com) (setvar "CTAB" "Model") (setq lst_pr (llayouts)) (setq d 1) (while (member (strcat "Fenetre" (rtos d 2 0)) lst_pr) (setq d (1+ d)) ) (setq nom_pr1 (strcat "Fenetre" (rtos d 2 0))) (setq lst1 (EchFen nom_pr1)) (if (not (member (nth 2 lst1) lst_pr)) (progn (if (not (tblsearch "LAYER" "Fenetre")) (command "_layer" "_N" "Fenetre" "_CO" "7" "Fenetre" "")) (setvar "CECOLOR" "DUCALQUE") (setvar "CLAYER" "Fenetre") (setvar "CMDECHO" 0) (setvar "OSMODE" 0) (setq pt1 (getpoint "\nSélectionner le centre de la fenêtre à créer: ")) (command "._layout" "N" (nth 2 lst1)) (setvar "CTAB" (nth 2 lst1)) (setq ss (ssget "_X")) (command "_.erase" ss "") (cond ((= (nth 1 lst1) "A4 Portait") (setvar "PLINEWID" 0.4782) (command "_pline" (list 202.8834 284.6971) (list 399.8845 284.6971) (list 399.8845 0.6712) (list 202.8834 0.6712) "c" ) (setvar "PLINEWID" 0) (command "_pline" (list 204.796 282.7845) (list 397.9719 282.7845) (list 397.9719 2.5838) (list 204.796 2.5838) "c" ) (command "fmult" (list 204.796 2.5838) (list 397.9719 282.7845)) (setq echl (/ 1000 (atof (nth 0 lst1)))) (command "_mspace") (command "zoom" "c" pt1 (strcat (rtos echl 2 2) "xp")) (command "_pspace") ) ((= (nth 1 lst1) "A4 Paysage") (setvar "PLINEWID" 0.4782) (command "_pline" (list 3.4622 4.008) (list 3.4622 201.0091) (list 287.4881 201.0091) (list 287.4881 4.008) "c" ) (setvar "PLINEWID" 0) (command "_pline" (list 5.3748 5.9206) (list 5.3748 199.0965) (list 285.5755 199.0965) (list 285.5755 5.9206) "c" ) (command "fmult" (list 5.3748 5.9206) (list 285.5755 199.0965)) (setq echl (/ 1000 (atof (nth 0 lst1)))) (command "_mspace") (command "zoom" "c" pt1 (strcat (rtos echl 2 2) "xp")) (command "_pspace") ) ((= (nth 1 lst1) "A3 Portait") (setvar "PLINEWID" 0.4782) (command "_pline" (list 2.6765 3.0634) (list 2.6765 397.0656) (list 286.7024 397.0656) (list 286.7024 3.0634) "c" ) (setvar "PLINEWID" 0) (command "_pline" (list 4.5891 4.976) (list 4.5891 395.153) (list 284.7898 395.153) (list 284.7898 4.976) "c" ) (command "fmult" (list 4.5891 4.976) (list 284.7898 395.153)) (setq echl (/ 1000 (atof (nth 0 lst1)))) (command "_mspace") (command "zoom" "c" pt1 (strcat (rtos echl 2 2) "xp")) (command "_pspace") ) ((= (nth 1 lst1) "A3 Paysage") (setvar "PLINEWID" 0.4782) (command "_pline" (list 5.8823 284.6971) (list 399.8845 284.6971) (list 399.8845 0.6712) (list 5.8823 0.6712) "c" ) (setvar "PLINEWID" 0) (command "_pline" (list 7.7949 282.7845) (list 397.9719 282.7845) (list 397.9719 2.5838) (list 7.7949 2.5838) "c" ) (command "fmult" (list 7.7949 2.5838) (list 397.9719 282.7845)) (setq echl (/ 1000 (atof (nth 0 lst1)))) (command "_mspace") (command "zoom" "c" pt1 (strcat (rtos echl 2 2) "xp")) (command "_pspace") ) ) (setvar "OSMODE" 65) (setvar "CMDECHO" 1) ) (progn (alert "La présentation existe déjà - Changer de nom") (exit) ) ) (prin1) ) (defun llayouts (/ acadobject ActDoc LAYOUTS LLAY n) (setq acadObject (vlax-get-acad-object)) (setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object))) (setq LAYOUTS (vla-get-Layouts ActDoc)) (setq LLAY nil) (vlax-for n LAYOUTS (setq LLAY (cons (vla-get-name n) LLAY)) ) LLAY ) (defun EchFen (nom_pr1 / tmp file dcl_id echl lech typ ltyp nom_pr) ;; créer un fichier temporaire et l'ouvrir en écriture (setq tmp (vl-filename-mktemp "tmp.dcl") file (open tmp "w")) ;; écrire dans le fichier (write-line (strcat "EchFen:dialog { label = \"Echelle Fenêtre\"; initial_focus = \"echl\"; :popup_list { key = \"echl\"; label = \"Choisir Echelle\"; edit_width = 10; } :popup_list { key = \"typ\"; label = \"Choisir Format\"; edit_width = 10; } :edit_box { key = \"nom_pr\"; label = \"Nom Fenêtre\"; edit_width = 11; } spacer; ok_cancel; } ") file ) ;; fermer le fichier (close file) ;; charger le fichier (setq dcl_id (load_dialog tmp)) ;; Appeler la boite de dialogue (if (not (new_dialog "EchFen" dcl_id)) (exit) ) ;;; initialisation de la boite (setq lech '("100" "125" "150" "200" "250" "500" "1000" "1250" "1500" "2000" "2500" "5000")) (setq ltyp '("A4 Portait" "A4 Paysage" "A3 Portait" "A3 Paysage")) ;; initialiser la liste echl (start_list "echl") (mapcar 'add_list lech) (end_list) (start_list "typ") (mapcar 'add_list ltyp) (end_list) (set_tile "nom_pr" nom_pr1) ;; action si l'utilisateur clique "OK" : ;; lst = liste des entrées et fermeture de la boite (action_tile "accept" "(setq lstf (list (nth (atoi (get_tile \"echl\")) lech) (nth (atoi (get_tile \"typ\")) ltyp) (get_tile \"nom_pr\") )) (done_dialog)" ) ;; afficher la boite de dialogue (start_dialog) ;; décharger la boite de dialogue (unload_dialog dcl_id) ;; supprimer le fichier (vl-file-delete tmp) lstf ) John

Ton lisp Bryce marche nickel chrome [Edité le 1/3/2011 par chris_mtp]

Bonjour, Je n'ai pas de problème de mon côté comme l'indique Lilli Testé sur Autocad v2010 full Par contre, avec le fichier de Lilli, il me semble qu'il y ait un problème mais quoi ? Je vais essayer de voir plus en détail John [Edité le 19/2/2011 par chris_mtp]

C'est dommage de ne pas avoir de suite à ce sujet très interressant qui pourrait être bien utile Pour ma part, projeter un point sur une polyligne 3D en l'interpolant, c'est à dire récupérer le Z de la polyligne 3D et non du point projeté, je ne vois vraiment pas comment faire Peut être que Gile aurait une solution si tu nous entends...... John

Voici une première ébauche mais si tu veux un lisp plus complet, il faudrait éclaircir concrètement ta demande, Ce lisp ne marche que pour des polylignes 2D simples, non optimisés et avec des noms de rues sous forme de texte (defun c:aep1 (/ ss file i ent txt txt1 diam ldxf_10 len) (prompt "\nSélectionner les polylignes à lister dans fichier .xls") (setq ss (ssget '((0 . "LWPOLYLINE")))) (if (= ss nil) (progn (prompt "\nPas de polylignes sélectionnés") (exit) ) (progn (setq file (open "C:/TMP/Reseau_AEP.xls" "w")) (write-line (strcat "Nom Rue" "\t" "ØAEP" "\t" "Longueur Conduite") file) (setq i 0) (repeat (sslength ss) (setq ent (ssname ss i)) (setq txt1 (car (entsel (strcat "\nSélectionner le nom de la rue de la conduite n° " (itoa (1+ i)))))) (setq txt (cdr (assoc 1 (entget txt1)))) (setq diam (cdr (assoc 8 (entget ent)))) (setq ldxf_10 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent)))) (setq len (vlax-curve-getDistAtParam ent (- (length ldxf_10) 1))) (write-line (strcat txt "\t" diam "\t" (rtos len 2 5)) file) (setq i (+ i 1)) ) (close file) (OpenExcel "C:/TMP/Reseau_AEP.xls" nil t) ) ) (prin1) ) De plus, il te faut pour le faire marcher la OpenExcel que Gile à merveillement réalisé que tu pourras trouver ici http:// http://www.cadxp.com/XForum+print-fid-141-tid-17416.html John

Désolé, j'ai oublié de citer la source de ce code qui vient de Gile Ce lisp m'a rendu de nombreux services. Merci encore Gile

Bonjour Peut-être qu'avec ce lisp en l'adaptant un peu, VtKp devrait trouver son bonheur (defun c:pn1 (/ blk pl elv dist ss ins p1 p2 new i dist1) (vl-load-com) (or *acdoc* (setq *acdoc* (vla-get-ActiveDocument (vlax-get-acad-object))) ) (if (and (setq blk (car (entsel "\nSélectionnez un des blocs à traiter: "))) (setq blk (vlax-ename->vla-object blk)) (= (vla-get-ObjectName blk) "AcDbBlockReference") (setq pl (car (entsel "\nSélectionnez la polyligne: "))) (setq pl (vlax-ename->vla-object pl)) (= (vla-get-ObjectName pl) "AcDbPolyline") (setq elv (vla-get-Elevation pl)) (setq dist (getdist "\nSpécifiez la longueur minimale : ")) (ssget "_X" (list '(0 . "INSERT") (cons 2 (vla-get-Name blk))) ) ) (progn (vla-add (vla-get-Layers *acdoc*) "BLOCS_PROJETES") (setq i 1) (vlax-for b (setq ss (vla-get-ActiveSelectionSet *acdoc*)) (setq ins (vlax-get b 'InsertionPoint)) (if (<= (distance (setq p1 (list (car ins) (cadr ins) elv)) (setq p2 (vlax-curve-getClosestPointTo pl p1)) ) dist ) (progn (setq new (vla-Copy b)) (vla-Move new (vlax-3d-point ins) (vlax-3d-point (list (car p2) (cadr p2) (caddr ins))) ) (setq dist1 (distance p1 p2)) (vla-put-Layer new "BLOCS_PROJETES") ) ) (setq i (1+ i)) ) (vla-delete ss) ) ) (princ) )