bonuscad

Comme (gile) était surpris que je n'ai effectué aucune proposition, voici la mienne. ;) Voila le code fonctionne avec le dessin proposé et dans le SCG, je ne suis pas allé plus loin pour l'instant. (la variable "par" est réglée à 3.5 pour ce dessin) Lors de l'utilisation le Z du curseur (si dans 3dFace) est affiché en dynamique dans la barre d'état des coordonnées. (defun punktinpolylinie (pointinquestion point_list /) (if (equal 0.0 (pipwinkelsumme pointinquestion point_list) 0.0001 ) nil t ) ) (defun pipwinkelsumme (pointinquestion point_list / count p1 p2 scheitel winkeleins winkelzwei ) (setq winkeleins 0.0 scheitel (car point_list) count 1 ) (while (< 1 (length point_list)) (setq p1 (car point_list) p2 (cadr point_list) point_list (cdr point_list) winkelzwei (pipwinkelhilfe pointinquestion p1 p2) winkelzwei (if (< 180.0 winkelzwei) (- winkelzwei 360.0) winkelzwei ) winkeleins (+ winkeleins winkelzwei) ) (setq count (1+ count)) ) (setq winkelzwei (pipwinkelhilfe pointinquestion p2 scheitel) winkelzwei (if (< 180.0 winkelzwei) (- winkelzwei 360.0) winkelzwei ) ) (+ winkeleins winkelzwei) ) (defun pipwinkelhilfe (pointinquestion p1 p2 / alpha beta) (setq beta (angle pointinquestion p1) alpha (angle pointinquestion p2) alpha (- alpha beta) ) (if (< alpha 0) (setq alpha (+ (* 2 pi) alpha)) ) (* (/ (float alpha) pi) 180.0) ) (defun C:ID-Z_3DFACE (/ tmp cod_rub par ps1 ps2 ps3 ps4 js n px dxf_ent lst_pt p1 p2 p3 xn yn zn zx p ) (princ "\n[Click-Gauche]: Identification 3D Actif/Inactif [Click-Droit]: Quitte la commande " ) (princ "\nID3Dyn [b]<<[/b]INACTIF>>") (while (or (= 5 (car (setq tmp (grread t 1 0)))) (= 3 (car tmp))) (cond ((= 3 (car tmp)) (if (null cod_rub) (progn (setq cod_rub T) (princ "\nID3Dyn [b]<<[/b]ACTIF>>") ) (progn (setq cod_rub nil) (princ "\nID3Dyn [b]<<[/b]INACTIF>>") ) ) ) ((= 5 (car tmp)) (cond (cod_rub (setq par 3.5 ps1 (list (+ (car (cadr tmp)) par) (+ (cadr (cadr tmp)) par) ) ps2 (list (+ (car (cadr tmp)) par) (- (cadr (cadr tmp)) par) ) ps3 (list (- (car (cadr tmp)) par) (- (cadr (cadr tmp)) par) ) ps4 (list (- (car (cadr tmp)) par) (+ (cadr (cadr tmp)) par) ) js (ssget "_CP" (list ps1 ps2 ps3 ps4) '((0 . "3DFACE"))) n -1 px (list (car (cadr tmp)) (cadr (cadr tmp)) 0.0) ) (cond (js (repeat (sslength js) (setq dxf_ent (entget (ssname js (setq n (1+ n)))) lst_pt (list (cdr (assoc 10 dxf_ent)) (cdr (assoc 11 dxf_ent)) (cdr (assoc 12 dxf_ent)) (cdr (assoc 13 dxf_ent)) ) ) (if (equal (caddr lst_pt) (cadddr lst_pt)) (setq lst_pt (list (car lst_pt) (cadr lst_pt) (caddr lst_pt) (car lst_pt) ) ) (setq lst_pt (append lst_pt (list (car lst_pt)))) ) (if (punktinpolylinie px lst_pt) (progn (setq p1 (car lst_pt) p2 (cadr lst_pt) p3 (caddr lst_pt) ) (setq xn (- (* (- (cadr p2) (cadr p1)) (- (caddr p3) (caddr p1)) ) (* (- (cadr p3) (cadr p1)) (- (caddr p2) (caddr p1)) ) ) yn (- (* (- (car p3) (car p1)) (- (caddr p2) (caddr p1)) ) (* (- (car p2) (car p1)) (- (caddr p3) (caddr p1)) ) ) zn (- (* (- (car p2) (car p1)) (- (cadr p3) (cadr p1)) ) (* (- (car p3) (car p1)) (- (cadr p2) (cadr p1)) ) ) ) (setq zx (/ (- (+ (* (car p1) xn) (* (cadr p1) yn) (* (caddr p1) zn) ) (* (car px) xn) (* (cadr px) yn) ) zn ) ) (setq p (list (car px) (cadr px) zx)) ) ) ) ) ) (cond (p (setq p (trans p 1 0)) (grtext -2 (strcat (rtos (car p)) "," (rtos (cadr p)) "," (rtos (caddr p)) ) ) ) (grtext -2 "") ) (setq p nil) ) (T nil) ) ) (T (princ "\nArrêt anormal de la commande ")) ) ) (grtext -2 "") (princ "\nMode interrogation point 3D en dynamique terminé. " ) (prin1) )

Le fichier donné par lovecraft dans le sujet Challenge11 , se prête bien pour faire un essai. :o concurrencer une équipe de développeurs à moi tout seul, je crois que ma vie ne suffirait pas... ;) Voilà on peut faire une coupe cotée rapidement, simplement avec une version pleine d'autocad. Si tu as un "voyage" de coupe à faire Covadis ou Mensura sont fortement conseillé. :)

Bonjour, J'ai essayé d'adapter plusieurs routines que j'avais faites. Le code est du coup un peu brouillon, mais je vous le livre pour un premier essai, en espérant que le copié-collé fonctionnera. Il faut dans le dessin des 3d faces et une ligne représentant la coupe à effectuer. (l'axe de la coupe sera au milieu de la ligne sélectionnée) La routine effectue alors la coupe dans un calque précis et cote celui-ci comme un profil en travers. Les commandes dispo sont COUPE_TN et CHOISIR_COUPE "Choisir_coupe" permet de recoter la coupe TN si on a modifié la polyligne de TN verte. On peut aussi dessiner d'autres polylignes (rouge, cyan, bleu) dans la coupe effectuée, et lors de la relance de "Choisir_coupe", recote toute les lwpolylignes et réadapte le cartouche. ((lambda (/) (if (null (tblsearch "STYLE" "COT_TRF")) (command "_.style" "$TRF_COT" "MONOTXT" "0.0" "0.9" "0.0" "_N" "_N" "_N") ) (if (null (tblsearch "LTYPE" "AXES2")) (progn (command "_.linetype" "_load" "AXES2" "ACADISO.LIN" "") (setvar "ltscale" 1.0) ) ) (if (null (tblsearch "BLOCK" "TRF_ALTI")) (progn (entmake) (entmake '((0 . "BLOCK") (2 . "TRF_ALTI") (8 . "0") (70 . 66) (10 0.0 0.0 0.0))) (entmake '((0 . "ATTDEF") (8 . "0") (10 0.0 0.0 0.0) (40 . 0.2) (1 . "") (3 . "Altitude du point") (2 . "ALTI") (70 . 0) (50 . 1.570796326794896) (7 . "$TRF_COT") (72 . 2))) (entmake '((0 . "ENDBLK"))) ) ) (if (null (tblsearch "BLOCK" "TRF_DIST")) (progn (entmake) (entmake '((0 . "BLOCK") (2 . "TRF_DIST") (8 . "0") (70 . 66) (10 0.0 0.0 0.0))) (entmake '((0 . "ATTDEF") (8 . "0") (10 0.0 0.0 0.0) (40 . 0.2) (1 . "") (3 . "Distance du point") (2 . "DIST") (70 . 0) (50 . 1.570796326794896) (7 . "$TRF_COT") (72 . 2))) (entmake '((0 . "ENDBLK"))) ) ) (if (null (tblsearch "BLOCK" "TRF_TITRE_CARTRAV")) (progn (entmake) (entmake '((0 . "BLOCK") (2 . "TRF_TITRE_CARTRAV") (8 . "0") (70 . 66) (10 0.0 0.0 0.0))) (entmake '((0 . "LINE") (8 . "0") (10 0.0 0.0 0.0) (11 -6.0 0.0 0.0) (210 0.0 0.0 1.0))) (entmake '((0 . "TEXT") (8 . "0") (10 -6.0 4.0 0.0) (40 . 0.3) (1 . "PROFIL No") (7 . "$TRF_COT") (210 0.0 0.0 1.0))) (entmake '((0 . "ATTDEF") (8 . "0") (10 -3.1 4.0 0.0) (40 . 0.3) (1 . "1") (3 . "Numéro du profil ?:") (2 . "NO-PR") (70 . 0) (7 . "$TRF_COT") (210 0.0 0.0 0.0))) (entmake '((0 . "TEXT") (8 . "0") (10 -6.0 2.5 0.0) (40 . 0.3) (1 . "ABSCISSE =") (7 . "$TRF_COT") (210 0.0 0.0 1.0))) (entmake '((0 . "ATTDEF") (8 . "0") (10 -2.8 2.5 0.0) (40 . 0.3) (1 . "0.00") (3 . "Abscisse du profil ?:") (2 . "ABS-PR") (70 . 0) (7 . "$TRF_COT") (210 0.0 0.0 0.0))) (entmake '((0 . "TEXT") (8 . "0") (10 -6.0 2.0 0.0) (40 . 0.3) (1 . "ECH = 1/") (7 . "$TRF_COT") (210 0.0 0.0 1.0))) (entmake '((0 . "ATTDEF") (8 . "0") (10 -3.55 2.0 0.0) (40 . 0.3) (1 . "100") (3 . "Echelle du profil ?:") (2 . "ECH-PR") (70 . 0) (7 . "$TRF_COT") (210 0.0 0.0 0.0))) (entmake '((0 . "TEXT") (8 . "0") (10 -6.0 1.0 0.0) (40 . 0.3) (1 . "PC =") (7 . "$TRF_COT") (210 0.0 0.0 1.0))) (entmake '((0 . "ATTDEF") (8 . "0") (10 -4.5 1.0 0.0) (40 . 0.3) (1 . "100") (3 . "Plan de comparaison du profil ?:") (2 . "PC-PR") (70 . 0) (7 . "$TRF_COT") (210 0.0 0.0 0.0))) (entmake '((0 . "ENDBLK"))) ) ) (if (null (tblsearch "BLOCK" "TRF_CARTRAV")) (progn (entmake) (entmake '((0 . "BLOCK") (2 . "TRF_CARTRAV") (8 . "0") (70 . 66) (10 0.0 0.0 0.0))) (entmake '((0 . "LINE") (8 . "0") (10 -6.0 0.0 0.0) (11 -6.0 -2.75 0.0) (210 0.0 0.0 1.0))) (entmake '((0 . "LINE") (8 . "0") (10 -6.0 -2.75 0.0) (11 0.0 -2.75 0.0) (210 0.0 0.0 1.0))) (entmake '((0 . "LINE") (8 . "0") (10 -0.35 0.0 0.0) (11 -0.35 -2.75 0.0) (210 0.0 0.0 1.0))) (entmake '((0 . "LINE") (8 . "0") (10 -0.35 -1.375 0.0) (11 0.0 -1.375 0.0) (210 0.0 0.0 1.0))) (entmake '((0 . "TEXT") (8 . "0") (10 0.0 0.0 0.0) (40 . 0.3) (1 . "DISTANCES") (7 . "$TRF_COT") (72 . 2) (11 -0.5 -0.6875 0.0) (210 0.0 0.0 1.0) (73 . 2))) (entmake '((0 . "TEXT") (8 . "0") (10 0.0 0.0 0.0) (40 . 0.3) (1 . "COTES") (7 . "$TRF_COT") (72 . 2) (11 -0.5 -2.0625 0.0) (210 0.0 0.0 1.0) (73 . 2))) (entmake '((0 . "ATTDEF") (8 . "0") (10 0.0 0.0 0.0) (40 . 0.3) (1 . "TERRAIN") (3 . "Quel ligne ?:") (2 . "INTITULE") (70 . 0) (7 . "$TRF_COT") (11 -5.7 -1.375 0.0) (210 0.0 0.0 0.0) (74 . 2))) (entmake '((0 . "ENDBLK"))) ) ) (if (null (tblsearch "BLOCK" "TRF_STRECHCART")) (progn (entmake) (entmake '((0 . "BLOCK") (2 . "TRF_STRECHCART") (8 . "0") (70 . 64) (10 0.0 0.0 0.0))) (entmake '((0 . "LINE") (8 . "0") (10 0.0 0.0 0.0) (11 1.0 0.0 0.0) (210 0.0 0.0 1.0))) (entmake '((0 . "LINE") (8 . "0") (10 1.0 0.0 0.0) (11 1.0 -2.75 0.0) (210 0.0 0.0 1.0))) (entmake '((0 . "LINE") (8 . "0") (10 1.0 -2.75 0.0) (11 0.0 -2.75 0.0) (210 0.0 0.0 1.0))) (entmake '((0 . "LINE") (8 . "0") (10 0.0 -1.375 0.0) (11 1.0 -1.375 0.0) (210 0.0 0.0 1.0))) (entmake '((0 . "ENDBLK"))) ) ) (if (null (tblsearch "BLOCK" "TRF_TIRET-COT")) (progn (entmake) (entmake '((0 . "BLOCK") (2 . "TRF_TIRET-COT") (8 . "0") (70 . 64) (10 0.0 0.0 0.0))) (entmake '((0 . "LINE") (8 . "0") (62 . 0) (10 0.0 -0.05 0.0) (11 0.0 0.05 0.0) (210 0.0 0.0 1.0))) (entmake '((0 . "ENDBLK"))) ) ) (if (null (tblsearch "BLOCK" "TRF_DRAPAX")) (progn (entmake) (entmake '((0 . "BLOCK") (2 . "TRF_DRAPAX") (8 . "0") (70 . 64) (10 0.0 0.0 0.0))) (entmake (list '(0 . "LINE") '(8 . "0") '(62 . 0) (cons 10 (list (* (sin (/ pi 4)) -0.25) (* (cos (/ pi 4)) -0.25) 0.0)) (cons 11 (list (* (sin (/ pi 4)) 0.5) (* (cos (/ pi 4)) 0.5) 0.0)) '(210 0.0 0.0 1.0) ) ) (entmake (list '(0 . "LINE") '(8 . "0") '(62 . 0) (cons 10 (list (* (sin (/ pi 4)) 0.5) (* (cos (/ pi 4)) 0.5) 0.0)) (cons 11 (list (* (sin (/ pi 4)) 0.5) (- (* (cos (/ pi 4)) 0.5) 0.25) 0.0)) '(210 0.0 0.0 1.0) ) ) (entmake (list '(0 . "LINE") '(8 . "0") '(62 . 0) (cons 10 (list (* (sin (/ pi 4)) 0.5) (- (* (cos (/ pi 4)) 0.5) 0.25) 0.0)) (cons 11 (list (+ (* (sin (/ pi 4)) -0.075) (* (sin (/ pi 4)) 0.5)) (+ (* (cos (/ pi 4)) 0.075) (- (* (cos (/ pi 4)) 0.5) 0.25)) 0.0)) '(210 0.0 0.0 1.0) ) ) (entmake (list '(0 . "LINE") '(8 . "0") '(62 . 0) (cons 10 (list (* (sin (/ pi 4)) 0.25) (* (cos (/ pi 4)) -0.25) 0.0)) (cons 11 (list (* (sin (/ pi 4)) -0.5) (* (cos (/ pi 4)) 0.5) 0.0)) '(210 0.0 0.0 1.0) ) ) (entmake (list '(0 . "LINE") '(8 . "0") '(62 . 0) (cons 10 (list (* (sin (/ pi 4)) -0.5) (* (cos (/ pi 4)) 0.5) 0.0)) (cons 11 (list (* (sin (/ pi 4)) -0.5) (- (* (cos (/ pi 4)) 0.5) 0.25) 0.0)) '(210 0.0 0.0 1.0) ) ) (entmake (list '(0 . "LINE") '(8 . "0") '(62 . 0) (cons 10 (list (* (sin (/ pi 4)) -0.5) (- (* (cos (/ pi 4)) 0.5) 0.25) 0.0)) (cons 11 (list (+ (* (sin (/ pi 4)) 0.075) (* (sin (/ pi 4)) -0.5)) (+ (* (cos (/ pi 4)) 0.075) (- (* (cos (/ pi 4)) 0.5) 0.25)) 0.0)) '(210 0.0 0.0 1.0) ) ) (entmake '((0 . "ENDBLK"))) ) ) )) (defun eob (arg / ) (/ (* arg echll) 100.0) ) (defun matrix (pt id / t_x t_y t_z t_v t_zo e_x e_y e_z nw_x nw_y nw_z) (setq t_x (trans '(1 0 0) 0 1 T) t_y (trans '(0 1 0) 0 1 T) t_z (trans '(0 0 1) 0 1 T) t_v (trans '(0 0 0) 1 0) t_zo (trans '(0 0 0) 0 1) ) (setq dxf_210 (list (caddr t_x) (caddr t_y) (caddr t_z))) (cond ((= id "2D") (setq e_x (car t_zo) e_y (cadr t_zo) e_z (caddr t_zo)) (setq dxf_10 (list 0.0 0.0 (- e_z))) (setq nw_x (+ (- (car t_zo)) (car pt))) (setq nw_y (+ (- (cadr t_zo)) (cadr pt))) (setq nw_z (+ (- (caddr t_zo)) (caddr pt))) ) ((= id "3D") (setq nw_x (+ (* (car pt) (car t_x)) (* (cadr pt) (cadr t_x)) (* (caddr pt) (caddr t_x)) (car t_v) ) ) (setq nw_y (+ (* (car pt) (car t_y)) (* (cadr pt) (cadr t_y)) (* (caddr pt) (caddr t_y)) (cadr t_v) ) ) (setq nw_z (+ (* (car pt) (car t_z)) (* (cadr pt) (cadr t_z)) (* (caddr pt) (caddr t_z)) (caddr t_v) ) ) ) ) (setq nw_pt (list nw_x nw_y nw_z)) ) (defun writ_cot (ent_po col_po / ptprc pdtx dxf_lst) (if (= col_po 3) (progn (entmake (list (cons 0 "INSERT") (cons 8 nouv) (cons 62 1) (cons 2 "TRF_DRAPAX") (cons 10 (matrix (list 0.0 (+ 1.5 high_z) 0.0) "2D")) (cons 41 (eob 1)) (cons 42 (eob 1)) (cons 43 (eob 1)) (cons 210 dxf_210) ) ) (entmake (list (cons 0 "LINE") (cons 8 nouv) (cons 62 1) (cons 6 "AXES2") (cons 10 (trans (list 0.0 (+ 1.5 high_z) 0.0) 1 0)) (cons 11 (trans (list 0.0 pc 0.0) 1 0)) (cons 210 dxf_210) ) ) (setq dxf_lst (entget ent_po)) ) (setq dxf_lst (reverse (entget ent_po))) ) (foreach pdtx (reverse (mapcar '(lambda (z) (trans (trans z ent_po 0) 0 1)) (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) dxf_lst)))) (cond ((/= ptprc ()) (if (or ([b]<[/b] (- (car pdtx) (car ptprc)) (eob 0.25)) ([b]<[/b] (car pdtx) (car ptprc)) ) (setq ptprc (cons (+ (car ptprc) (eob 0.25)) (list (cadr pdtx)))) (setq ptprc pdtx) ) ) (T (setq ptprc pdtx)) ) (entmake (list (cons 0 "INSERT") (cons 8 nouv) (cons 62 col_po) (cons 2 "TRF_TIRET-COT") (cons 10 (matrix pdtx "2D")) (cons 41 (eob 1)) (cons 42 (eob 1)) (cons 43 (eob 1)) (cons 210 dxf_210) ) ) (entmake) (entmake (list (cons 0 "INSERT") (cons 8 nouv) (cons 66 1) (cons 2 "TRF_DIST") (cons 10 (matrix (list (car ptprc) (- pc (eob 0.05)) 0.0) "2D")) (cons 41 (eob 1)) (cons 42 (eob 1)) (cons 43 (eob 1)) (cons 210 dxf_210) ) ) (entmake (list (cons 0 "ATTRIB") (cons 8 "0") (cons 10 (matrix (list (car ptprc) (- pc (eob 0.05)) 0.0) "2D")) (cons 40 (eob 0.2)) (cons 1 (rtos (car pdtx) 2 2)) (cons 2 "DIST") (cons 70 0) (cons 50 (/ pi 2)) (cons 7 "$TRF_COT") (cons 11 (matrix (list (car ptprc) (- pc (eob 0.05)) 0.0) "2D")) (cons 72 2) (cons 210 dxf_210) (cons 74 0) ) ) (entmake (list '(0 . "SEQEND") (cons 8 nouv))) (entmake) (entmake (list (cons 0 "INSERT") (cons 8 nouv) (cons 66 1) (cons 2 "TRF_ALTI") (cons 10 (matrix (list (car ptprc) (- pc (eob 1.425)) 0.0) "2D")) (cons 41 (eob 1)) (cons 42 (eob 1)) (cons 43 (eob 1)) (cons 210 dxf_210) ) ) (entmake (list (cons 0 "ATTRIB") (cons 8 "0") (cons 10 (matrix (list (car ptprc) (- pc (eob 1.425)) 0.0) "2D")) (cons 40 (eob 0.2)) (cons 1 (rtos (cadr pdtx) 2 2)) (cons 2 "ALTI") (cons 70 0) (cons 50 (/ pi 2)) (cons 7 "$TRF_COT") (cons 11 (matrix (list (car ptprc) (- pc (eob 1.425)) 0.0) "2D")) (cons 72 2) (cons 210 dxf_210) (cons 74 0) ) ) (entmake (list '(0 . "SEQEND") (cons 8 nouv))) ) ) (defun do_poly ( col / js_tmp ent_po ttr_ca) (setq js_tmp (ssget "X" (list '(0 . "LWPOLYLINE") (cons 62 col) (cons 8 nouv)))) (cond ((and js_tmp (eq (sslength js_tmp) 1)) (setq ent_po (ssname js_tmp 0)) (setq ttr_ca (cond ((eq col 1) "PROJET") ((eq col 4) "ASSISE") ((eq col 6) "FORME") ((eq col 5) "BASE") ) ) (setq pc (- pc (eob 2.75))) (setq pt_ins (trans (list (car (last lst_som)) pc 0.0) 1 0) pt_ins (matrix (trans pt_ins 0 1) "2D") pt_coi (trans (list (caar lst_som) pc 0.0) 1 0) ) (entmake) (entmake (list (cons 0 "INSERT") (cons 8 nouv) (cons 66 1) (cons 2 "TRF_CARTRAV") (cons 10 pt_ins) (cons 41 (eob 1)) (cons 42 (eob 1)) (cons 43 (eob 1)) (cons 210 dxf_210) ) ) (entmake (list (cons 0 "ATTRIB") (cons 8 "0") (cons 10 pt_ins) (cons 40 (eob 0.3)) (cons 1 ttr_ca) (cons 2 "INTITULE") (cons 70 0) (cons 7 "$TRF_COT") (cons 11 (list (+ (car pt_ins ) (eob -5.7)) (+ (cadr pt_ins) (eob -1.375)) (caddr pt_ins))) (cons 210 dxf_210) (cons 74 2) ) ) (entmake (list '(0 . "SEQEND") (cons 8 nouv))) (entmake (list (cons 0 "INSERT") (cons 8 nouv) (cons 66 0) (cons 2 "TRF_STRECHCART") (cons 10 pt_ins) (cons 41 (+ (distance (list (caar lst_som) pc 0.0) (list (car (last lst_som)) pc 0.0)) (eob 0.35))) (cons 42 (eob 1)) (cons 43 (eob 1)) (cons 210 dxf_210) ) ) (writ_cot ent_po col) (setq js_tmp nil) ) ) ) (defun c:choisir_coupe ( / echll nouv n_pr js cod js_tmp ent lst_som ent_po pc high_z pt_ins pt_coi dxf_210) (if (zerop (getvar "useri1")) (setvar "useri1" 100) ) (initget 6) (setq echll (getint (strcat "\nEntrez l'echelle du profil[b]<[/b]" (itoa (getvar "useri1")) ">: "))) (if (not echll) (setq echll (getvar "useri1"))) (setvar "useri1" echll) (setq nouv (getvar "clayer") n_pr (atoi (substr (getvar "clayer") 12)) a_curv 0.0) (command "._layer" "_thaw" nouv "_set" nouv "_freeze" "*" "_off" "*" "_on" nouv "") (command "_ucs" "_restore" nouv) (command "_.plan" "") (setq js (ssget "X" (list '(-4 . "[b]<[/b]OR") '(-4 . "[b]<[/b]AND") '(0 . "LINE") '(62 . 3) (cons 8 nouv) '(-4 . "AND>") '(-4 . "[b]<[/b]AND") '(0 . "INSERT") '(2 . "TRF_TITRE_CARTRAV") (cons 8 nouv) '(-4 . "AND>") '(-4 . "[b]<[/b]AND") '(0 . "INSERT") '(2 . "TRF_CARTRAV") (cons 8 nouv) '(-4 . "AND>") '(-4 . "[b]<[/b]AND") '(0 . "INSERT") '(2 . "TRF_STRECHCART") (cons 8 nouv) '(-4 . "AND>") '(-4 . "[b]<[/b]AND") '(0 . "INSERT") '(2 . "TRF_DIST") (cons 8 nouv) '(-4 . "AND>") '(-4 . "[b]<[/b]AND") '(0 . "INSERT") '(2 . "TRF_ALTI") (cons 8 nouv) '(-4 . "AND>") '(-4 . "[b]<[/b]AND") '(0 . "INSERT") '(2 . "TRF_TIRET-COT") (cons 8 nouv) '(-4 . "AND>") '(-4 . "[b]<[/b]AND") '(0 . "INSERT") '(2 . "TRF_DRAPAX") (cons 8 nouv) '(-4 . "AND>") '(-4 . "OR>") ) ) ) (cond (js (command "_.erase" "_previous" ""))) (setq js nil) (initget "Oui Non") (setq cod (getkword "\nMettre le profil a jour ? [Oui/Non] [b]<[/b]N>: ")) (if (eq cod ()) (setq cod "Non")) (cond ((eq cod "Oui") (prompt "\nMise à jour en cours...") (if (null (tblsearch "STYLE" "COT_TRF")) (command "_.style" "$TRF_COT" "MONOTXT" "0.0" "0.9" "0.0" "_N" "_N" "_N") ) (if (null (tblsearch "LTYPE" "AXES2")) (progn (command "_.linetype" "_load" "AXES2" "ACADISO.LIN" "") (setvar "ltscale" 1.0) ) ) (if (null (tblsearch "BLOCK" "TRF_ALTI")) (progn (entmake) (entmake '((0 . "BLOCK") (2 . "TRF_ALTI") (8 . "0") (70 . 66) (10 0.0 0.0 0.0))) (entmake '((0 . "ATTDEF") (8 . "0") (10 0.0 0.0 0.0) (40 . 0.2) (1 . "") (3 . "Altitude du point") (2 . "ALTI") (70 . 0) (50 . 1.570796326794896) (7 . "$TRF_COT") (72 . 2))) (entmake '((0 . "ENDBLK"))) ) ) (if (null (tblsearch "BLOCK" "TRF_DIST")) (progn (entmake) (entmake '((0 . "BLOCK") (2 . "TRF_DIST") (8 . "0") (70 . 66) (10 0.0 0.0 0.0))) (entmake '((0 . "ATTDEF") (8 . "0") (10 0.0 0.0 0.0) (40 . 0.2) (1 . "") (3 . "Distance du point") (2 . "DIST") (70 . 0) (50 . 1.570796326794896) (7 . "$TRF_COT") (72 . 2))) (entmake '((0 . "ENDBLK"))) ) ) (if (null (tblsearch "BLOCK" "TRF_TITRE_CARTRAV")) (progn (entmake) (entmake '((0 . "BLOCK") (2 . "TRF_TITRE_CARTRAV") (8 . "0") (70 . 66) (10 0.0 0.0 0.0))) (entmake '((0 . "LINE") (8 . "0") (10 0.0 0.0 0.0) (11 -6.0 0.0 0.0) (210 0.0 0.0 1.0))) (entmake '((0 . "TEXT") (8 . "0") (10 -6.0 4.0 0.0) (40 . 0.3) (1 . "PROFIL No") (7 . "$TRF_COT") (210 0.0 0.0 1.0))) (entmake '((0 . "ATTDEF") (8 . "0") (10 -3.1 4.0 0.0) (40 . 0.3) (1 . "1") (3 . "Numéro du profil ?:") (2 . "NO-PR") (70 . 0) (7 . "$TRF_COT") (210 0.0 0.0 0.0))) (entmake '((0 . "TEXT") (8 . "0") (10 -6.0 2.5 0.0) (40 . 0.3) (1 . "ABSCISSE =") (7 . "$TRF_COT") (210 0.0 0.0 1.0))) (entmake '((0 . "ATTDEF") (8 . "0") (10 -2.8 2.5 0.0) (40 . 0.3) (1 . "0.00") (3 . "Abscisse du profil ?:") (2 . "ABS-PR") (70 . 0) (7 . "$TRF_COT") (210 0.0 0.0 0.0))) (entmake '((0 . "TEXT") (8 . "0") (10 -6.0 2.0 0.0) (40 . 0.3) (1 . "ECH = 1/") (7 . "$TRF_COT") (210 0.0 0.0 1.0))) (entmake '((0 . "ATTDEF") (8 . "0") (10 -3.55 2.0 0.0) (40 . 0.3) (1 . "100") (3 . "Echelle du profil ?:") (2 . "ECH-PR") (70 . 0) (7 . "$TRF_COT") (210 0.0 0.0 0.0))) (entmake '((0 . "TEXT") (8 . "0") (10 -6.0 1.0 0.0) (40 . 0.3) (1 . "PC =") (7 . "$TRF_COT") (210 0.0 0.0 1.0))) (entmake '((0 . "ATTDEF") (8 . "0") (10 -4.5 1.0 0.0) (40 . 0.3) (1 . "100") (3 . "Plan de comparaison du profil ?:") (2 . "PC-PR") (70 . 0) (7 . "$TRF_COT") (210 0.0 0.0 0.0))) (entmake '((0 . "ENDBLK"))) ) ) (if (null (tblsearch "BLOCK" "TRF_CARTRAV")) (progn (entmake) (entmake '((0 . "BLOCK") (2 . "TRF_CARTRAV") (8 . "0") (70 . 66) (10 0.0 0.0 0.0))) (entmake '((0 . "LINE") (8 . "0") (10 -6.0 0.0 0.0) (11 -6.0 -2.75 0.0) (210 0.0 0.0 1.0))) (entmake '((0 . "LINE") (8 . "0") (10 -6.0 -2.75 0.0) (11 0.0 -2.75 0.0) (210 0.0 0.0 1.0))) (entmake '((0 . "LINE") (8 . "0") (10 -0.35 0.0 0.0) (11 -0.35 -2.75 0.0) (210 0.0 0.0 1.0))) (entmake '((0 . "LINE") (8 . "0") (10 -0.35 -1.375 0.0) (11 0.0 -1.375 0.0) (210 0.0 0.0 1.0))) (entmake '((0 . "TEXT") (8 . "0") (10 0.0 0.0 0.0) (40 . 0.3) (1 . "DISTANCES") (7 . "$TRF_COT") (72 . 2) (11 -0.5 -0.6875 0.0) (210 0.0 0.0 1.0) (73 . 2))) (entmake '((0 . "TEXT") (8 . "0") (10 0.0 0.0 0.0) (40 . 0.3) (1 . "COTES") (7 . "$TRF_COT") (72 . 2) (11 -0.5 -2.0625 0.0) (210 0.0 0.0 1.0) (73 . 2))) (entmake '((0 . "ATTDEF") (8 . "0") (10 0.0 0.0 0.0) (40 . 0.3) (1 . "TERRAIN") (3 . "Quel ligne ?:") (2 . "INTITULE") (70 . 0) (7 . "$TRF_COT") (11 -5.7 -1.375 0.0) (210 0.0 0.0 0.0) (74 . 2))) (entmake '((0 . "ENDBLK"))) ) ) (if (null (tblsearch "BLOCK" "TRF_STRECHCART")) (progn (entmake) (entmake '((0 . "BLOCK") (2 . "TRF_STRECHCART") (8 . "0") (70 . 64) (10 0.0 0.0 0.0))) (entmake '((0 . "LINE") (8 . "0") (10 0.0 0.0 0.0) (11 1.0 0.0 0.0) (210 0.0 0.0 1.0))) (entmake '((0 . "LINE") (8 . "0") (10 1.0 0.0 0.0) (11 1.0 -2.75 0.0) (210 0.0 0.0 1.0))) (entmake '((0 . "LINE") (8 . "0") (10 1.0 -2.75 0.0) (11 0.0 -2.75 0.0) (210 0.0 0.0 1.0))) (entmake '((0 . "LINE") (8 . "0") (10 0.0 -1.375 0.0) (11 1.0 -1.375 0.0) (210 0.0 0.0 1.0))) (entmake '((0 . "ENDBLK"))) ) ) (if (null (tblsearch "BLOCK" "TRF_TIRET-COT")) (progn (entmake) (entmake '((0 . "BLOCK") (2 . "TRF_TIRET-COT") (8 . "0") (70 . 64) (10 0.0 0.0 0.0))) (entmake '((0 . "LINE") (8 . "0") (62 . 0) (10 0.0 -0.05 0.0) (11 0.0 0.05 0.0) (210 0.0 0.0 1.0))) (entmake '((0 . "ENDBLK"))) ) ) (if (null (tblsearch "BLOCK" "TRF_DRAPAX")) (progn (entmake) (entmake '((0 . "BLOCK") (2 . "TRF_DRAPAX") (8 . "0") (70 . 64) (10 0.0 0.0 0.0))) (entmake (list '(0 . "LINE") '(8 . "0") '(62 . 0) (cons 10 (list (* (sin (/ pi 4)) -0.25) (* (cos (/ pi 4)) -0.25) 0.0)) (cons 11 (list (* (sin (/ pi 4)) 0.5) (* (cos (/ pi 4)) 0.5) 0.0)) '(210 0.0 0.0 1.0))) (entmake (list '(0 . "LINE") '(8 . "0") '(62 . 0) (cons 10 (list (* (sin (/ pi 4)) 0.5) (* (cos (/ pi 4)) 0.5) 0.0)) (cons 11 (list (* (sin (/ pi 4)) 0.5) (- (* (cos (/ pi 4)) 0.5) 0.25) 0.0)) '(210 0.0 0.0 1.0))) (entmake (list '(0 . "LINE") '(8 . "0") '(62 . 0) (cons 10 (list (* (sin (/ pi 4)) 0.5) (- (* (cos (/ pi 4)) 0.5) 0.25) 0.0)) (cons 11 (list (+ (* (sin (/ pi 4)) -0.075) (* (sin (/ pi 4)) 0.5)) (+ (* (cos (/ pi 4)) 0.075) (- (* (cos (/ pi 4)) 0.5) 0.25)) 0.0)) '(210 0.0 0.0 1.0))) (entmake (list '(0 . "LINE") '(8 . "0") '(62 . 0) (cons 10 (list (* (sin (/ pi 4)) 0.25) (* (cos (/ pi 4)) -0.25) 0.0)) (cons 11 (list (* (sin (/ pi 4)) -0.5) (* (cos (/ pi 4)) 0.5) 0.0)) '(210 0.0 0.0 1.0))) (entmake (list '(0 . "LINE") '(8 . "0") '(62 . 0) (cons 10 (list (* (sin (/ pi 4)) -0.5) (* (cos (/ pi 4)) 0.5) 0.0)) (cons 11 (list (* (sin (/ pi 4)) -0.5) (- (* (cos (/ pi 4)) 0.5) 0.25) 0.0)) '(210 0.0 0.0 1.0))) (entmake (list '(0 . "LINE") '(8 . "0") '(62 . 0) (cons 10 (list (* (sin (/ pi 4)) -0.5) (- (* (cos (/ pi 4)) 0.5) 0.25) 0.0)) (cons 11 (list (+ (* (sin (/ pi 4)) 0.075) (* (sin (/ pi 4)) -0.5)) (+ (* (cos (/ pi 4)) 0.075) (- (* (cos (/ pi 4)) 0.5) 0.25)) 0.0)) '(210 0.0 0.0 1.0))) (entmake '((0 . "ENDBLK"))) ) ) (setq js_tmp (ssget "X" (list '(0 . "LWPOLYLINE") '(62 . 3) (cons 8 nouv)))) (cond ((and js_tmp (eq (sslength js_tmp) 1)) (setq ent (ssname js_tmp 0) lst_som '() ent_po ent) (setq lst_som (mapcar '(lambda (z) (trans (trans z ent 0) 0 1)) (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent))))) (setq pc (cadar lst_som) high_z pc) (foreach n lst_som (setq pc (min pc (cadr n)))) (foreach n lst_som (setq high_z (max high_z (cadr n)))) (setq pc (* (/ (fix pc) 10) 10)) (setq pt_ins (trans (list (car (last lst_som)) pc 0.0) 1 0) pt_coi (trans (list (caar lst_som) pc 0.0) 1 0) ) (matrix '(0 0 0) "2D") (entmake (list (cons 0 "LINE") (cons 8 nouv) (cons 62 3) (cons 10 (trans (list (car (last lst_som)) (cadr (last lst_som)) 0.0) 1 0)) (cons 11 pt_ins) (cons 210 dxf_210) ) ) (entmake (list (cons 0 "LINE") (cons 8 nouv) (cons 62 3) (cons 10 (trans (list (caar lst_som) (cadar lst_som) 0.0) 1 0)) (cons 11 pt_coi) (cons 210 dxf_210) ) ) (setq pt_ins (matrix (trans pt_ins 0 1) "2D")) (entmake) (entmake (list (cons 0 "INSERT") (cons 8 nouv) (cons 66 1) (cons 2 "TRF_TITRE_CARTRAV") (cons 10 pt_ins) (cons 41 (eob 1)) (cons 42 (eob 1)) (cons 43 (eob 1)) (cons 210 dxf_210) ) ) (entmake (list (cons 0 "ATTRIB") (cons 8 "0") (cons 10 (list (+ (car pt_ins ) (eob -3.1)) (+ (cadr pt_ins) (eob 4.0)) (caddr pt_ins))) (cons 40 (eob 0.3)) (cons 1 (itoa n_pr)) (cons 2 "NO-PR") (cons 70 0) (cons 7 "$TRF_COT") (cons 210 dxf_210) ) ) (entmake (list (cons 0 "ATTRIB") (cons 8 "0") (cons 10 (list (+ (car pt_ins ) (eob -2.8)) (+ (cadr pt_ins) (eob 2.5)) (caddr pt_ins))) (cons 40 (eob 0.3)) (cons 1 (rtos a_curv 2 2)) (cons 2 "ABS-PR") (cons 70 0) (cons 7 "$TRF_COT") (cons 210 dxf_210) ) ) (entmake (list (cons 0 "ATTRIB") (cons 8 "0") (cons 10 (list (+ (car pt_ins ) (eob -3.7)) (+ (cadr pt_ins) (eob 2.0)) (caddr pt_ins))) (cons 40 (eob 0.3)) (cons 1 (itoa echll)) (cons 2 "ECH-PR") (cons 70 0) (cons 7 "$TRF_COT") (cons 210 dxf_210) ) ) (entmake (list (cons 0 "ATTRIB") (cons 8 "0") (cons 10 (list (+ (car pt_ins ) (eob -4.5)) (+ (cadr pt_ins) (eob 1.0)) (caddr pt_ins))) (cons 40 (eob 0.3)) (cons 1 (itoa pc)) (cons 2 "PC-PR") (cons 70 0) (cons 7 "$TRF_COT") (cons 210 dxf_210) ) ) (entmake (list '(0 . "SEQEND") (cons 8 nouv))) (entmake) (entmake (list (cons 0 "INSERT") (cons 8 nouv) (cons 66 1) (cons 2 "TRF_CARTRAV") (cons 10 pt_ins) (cons 41 (eob 1)) (cons 42 (eob 1)) (cons 43 (eob 1)) (cons 210 dxf_210) ) ) (entmake (list (cons 0 "ATTRIB") (cons 8 "0") (cons 10 pt_ins) (cons 40 (eob 0.3)) (cons 1 "TERRAIN") (cons 2 "INTITULE") (cons 70 0) (cons 7 "$TRF_COT") (cons 11 (list (+ (car pt_ins ) (eob -5.7)) (+ (cadr pt_ins) (eob -1.375)) (caddr pt_ins))) (cons 210 dxf_210) (cons 74 2) ) ) (entmake (list '(0 . "SEQEND") (cons 8 nouv))) (entmake (list (cons 0 "INSERT") (cons 8 nouv) (cons 66 0) (cons 2 "TRF_STRECHCART") (cons 10 pt_ins) (cons 41 (+ (distance (list (caar lst_som) pc 0.0) (list (car (last lst_som)) pc 0.0)) (eob 0.35))) (cons 42 (eob 1)) (cons 43 (eob 1)) (cons 210 dxf_210) ) ) (writ_cot ent_po 3) (setq js_tmp nil) (foreach n '(1 4 6 5) (do_poly n) ) ) ) ) ) (command "_.zoom" "_extent") ) (defun c:coupe_tn ( / js_line dxf_line p1 p2 all_pt js n lst_px dxf_ent lst_pt px new_lst l el pt_all nouv n_pr echll a_curv ent lst_som ent_po pc high_z pt_ins pt_coi dxf_210) (setq js_line (ssget "_+.:E:S" '((0 . "LINE")))) (cond (js_line (setvar "cmdecho" 1) (setq dxf_line (entget (ssname js_line 0)) p1 (list (cadr (assoc 10 dxf_line)) (caddr (assoc 10 dxf_line))) p2 (list (cadr (assoc 11 dxf_line)) (caddr (assoc 11 dxf_line))) all_pt nil ) (command "_.zoom" "_window" p1 p2) (setq js (ssget "_F" (list p1 p2) '((0 . "3DFACE"))) n -1 lst_px nil ) (cond (js (repeat (sslength js) (setq dxf_ent (entget (ssname js (setq n (1+ n)))) lst_pt (list (cdr (assoc 10 dxf_ent)) (cdr (assoc 11 dxf_ent)) (cdr (assoc 12 dxf_ent)) (cdr (assoc 13 dxf_ent)) ) ) (if (equal (caddr lst_pt) (cadddr lst_pt)) (setq lst_pt (list (car lst_pt) (cadr lst_pt) (caddr lst_pt) (car lst_pt))) (setq lst_pt (append lst_pt (list (car lst_pt)))) ) (while (cdr lst_pt) (setq px (inters p1 p2 (car lst_pt) (cadr lst_pt) T)) (if px (progn (setq px (inters (list (car px) (cadr px) 0.0) (list (car px) (cadr px) 100.0) (car lst_pt) (cadr lst_pt) nil)) (if (and px (not (member px lst_px))) (setq lst_px (cons px lst_px)) ) ) ) (setq lst_pt (cdr lst_pt)) ) ) (if lst_px (progn (setq new_lst nil) (while lst_px (setq l (mapcar '(lambda (x) (distance x p1)) lst_px)) (setq el (nth (- (length lst_px) (length (member (apply 'min l) l))) lst_px)) (setq lst_px (vl-remove el lst_px) new_lst (cons el new_lst) ) ) (setq pt_all (append (list (cadr all_pt)) new_lst pt_all)) ) (setq pt_all (append (list (cadr all_pt)) pt_all)) ) ) ) (setq all_pt (cdr all_pt)) (setq nouv (strcat "TRF_PROFIL-" (itoa (setq n_pr (getint "\nNuméro du profil: "))))) (if (zerop (getvar "useri1")) (setvar "useri1" 100) ) (initget 6) (setq echll (getint (strcat "\nEntrez l'echelle du profil[b]<[/b]" (itoa (getvar "useri1")) ">: "))) (if (not echll) (setq echll (getvar "useri1"))) (setvar "useri1" echll) (setq a_curv (getdist "\nDistance cumulée du profil: ")) (setvar "expert" 5) (command "_.ucs" "_world") (command "_.ucs" "_3point" ".xy" "_none" (mapcar '* (mapcar '+ p1 p2) '(0.5 0.5)) 0.0 ".xy" "_none" p2 0.0 ".xy" "_none" (mapcar '* (mapcar '+ p1 p2) '(0.5 0.5)) 1000.0) (command "_.ucs" "_save" nouv) (command "_.plan" "") (command "._layer" "_make" nouv "_thaw" nouv "_set" nouv "_freeze" "*" "_off" "*" "_on" nouv "") (setvar "cecolor" "3") (command "_.pline") (foreach el (cdr pt_all) (command "_none" (trans el 0 1))) (command "") (setq ent (entlast) lst_som '() ent_po ent) (setvar "cecolor" "256") (entdel (cdar dxf_line)) (setq lst_som (mapcar '(lambda (z) (trans (trans z ent 0) 0 1)) (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent))))) (setq pc (cadar lst_som) high_z pc) (foreach n lst_som (setq pc (min pc (cadr n)))) (foreach n lst_som (setq high_z (max high_z (cadr n)))) (setq pc (* (/ (fix pc) 10) 10)) (setq pt_ins (trans (list (car (last lst_som)) pc 0.0) 1 0) pt_coi (trans (list (caar lst_som) pc 0.0) 1 0) ) (matrix '(0 0 0) "2D") (entmake (list (cons 0 "LINE") (cons 8 nouv) (cons 62 3) (cons 10 (trans (list (car (last lst_som)) (cadr (last lst_som)) 0.0) 1 0)) (cons 11 pt_ins) (cons 210 dxf_210) ) ) (entmake (list (cons 0 "LINE") (cons 8 nouv) (cons 62 3) (cons 10 (trans (list (caar lst_som) (cadar lst_som) 0.0) 1 0)) (cons 11 pt_coi) (cons 210 dxf_210) ) ) (setq pt_ins (matrix (trans pt_ins 0 1) "2D")) (entmake) (entmake (list (cons 0 "INSERT") (cons 8 nouv) (cons 66 1) (cons 2 "TRF_TITRE_CARTRAV") (cons 10 pt_ins) (cons 41 (eob 1)) (cons 42 (eob 1)) (cons 43 (eob 1)) (cons 210 dxf_210) ) ) (entmake (list (cons 0 "ATTRIB") (cons 8 "0") (cons 10 (list (+ (car pt_ins ) (eob -3.1)) (+ (cadr pt_ins) (eob 4.0)) (caddr pt_ins))) (cons 40 (eob 0.3)) (cons 1 (itoa n_pr)) (cons 2 "NO-PR") (cons 70 0) (cons 7 "$TRF_COT") (cons 210 dxf_210) ) ) (entmake (list (cons 0 "ATTRIB") (cons 8 "0") (cons 10 (list (+ (car pt_ins ) (eob -2.8)) (+ (cadr pt_ins) (eob 2.5)) (caddr pt_ins))) (cons 40 (eob 0.3)) (cons 1 (rtos a_curv 2 2)) (cons 2 "ABS-PR") (cons 70 0) (cons 7 "$TRF_COT") (cons 210 dxf_210) ) ) (entmake (list (cons 0 "ATTRIB") (cons 8 "0") (cons 10 (list (+ (car pt_ins ) (eob -3.7)) (+ (cadr pt_ins) (eob 2.0)) (caddr pt_ins))) (cons 40 (eob 0.3)) (cons 1 (itoa echll)) (cons 2 "ECH-PR") (cons 70 0) (cons 7 "$TRF_COT") (cons 210 dxf_210) ) ) (entmake (list (cons 0 "ATTRIB") (cons 8 "0") (cons 10 (list (+ (car pt_ins ) (eob -4.5)) (+ (cadr pt_ins) (eob 1.0)) (caddr pt_ins))) (cons 40 (eob 0.3)) (cons 1 (itoa pc)) (cons 2 "PC-PR") (cons 70 0) (cons 7 "$TRF_COT") (cons 210 dxf_210) ) ) (entmake (list '(0 . "SEQEND") (cons 8 nouv))) (entmake) (entmake (list (cons 0 "INSERT") (cons 8 nouv) (cons 66 1) (cons 2 "TRF_CARTRAV") (cons 10 pt_ins) (cons 41 (eob 1)) (cons 42 (eob 1)) (cons 43 (eob 1)) (cons 210 dxf_210) ) ) (entmake (list (cons 0 "ATTRIB") (cons 8 "0") (cons 10 pt_ins) (cons 40 (eob 0.3)) (cons 1 "TERRAIN") (cons 2 "INTITULE") (cons 70 0) (cons 7 "$TRF_COT") (cons 11 (list (+ (car pt_ins ) (eob -5.7)) (+ (cadr pt_ins) (eob -1.375)) (caddr pt_ins))) (cons 210 dxf_210) (cons 74 2) ) ) (entmake (list '(0 . "SEQEND") (cons 8 nouv))) (entmake (list (cons 0 "INSERT") (cons 8 nouv) (cons 66 0) (cons 2 "TRF_STRECHCART") (cons 10 pt_ins) (cons 41 (+ (distance (list (caar lst_som) pc 0.0) (list (car (last lst_som)) pc 0.0)) (eob 0.35))) (cons 42 (eob 1)) (cons 43 (eob 1)) (cons 210 dxf_210) ) ) (writ_cot ent_po 3) (foreach n '(1 4 6 5) (do_poly n) ) ) ) )

Oui, je m'en suis rendu compte par la suite... C'est un revendeur Autodesk agréé: "AriCAD" , c'est un site ftp pour leur clientèle. Il y a aussi quelque document pdf sur autocad, un fichier xls de traductions des commandes. Il y a même de la doc linux :P Autrement des drivers sur le matériel qu'ils vendent ou utilisent en interne. Du coup j'ai fais de la pub :( Mais bon leur ftp est quand même conséquent, et ça peut éviter de farfouiller sur le net pour trouver tout les palliatifs aux différents produits AutoDesk . fhervet (Franck Hervet) de aricad, pourra faire remonter que leur site ftp fonctionne bien :exclam: [Edité le 8/10/2007 par bonuscad]

Je viens de tomber dessus par hasard Je ne peux vous dire si c'est un site officiel, mais ça y ressemble fort... Comme je ne savais où poster? Si Patrick ou tout autres valident (ou non) ce lien Vos avis? http://80.11.109.4/ftp/patch/AUTODESK/

Pourquoi faire un getvar Expert si vous ne fixez pas cette variable à 4 ou plus ensuite. (setvar) Car si elle est à zéro ou < à 4 le comportement de la commande SCU sera inchangée. :o L'usage d'EXPERT dispense de l'usage de (tblsearch) et simplifie le code pour les conditions.

La commande _PSOUT (jusqu'à 2005 sur, après je ne sais pas) génère un format PostSript Encapsulé (EPS). Ce style de fichier est importable sous PhotoShop (je pense que pour Gimp, c'est valable aussi). Les fichiers EPS sont petit mais ils peuvent créer des fichier image énorme (et de bonne qualité) car c'est toi qui décide de la résoultion de ton image (le format Eps est pixellisé comme tu le souhaites lors de l'importation)

La solution de lovecraft de chercher l'existence dans la table est bonne. Mais si tu préfère écraser systématiquement le SCU "temp", mettre la variable EXPERT au minimum à 4. De cette façon tu es bien sûr de restorer le dernier SCU "temp" sauvegardé.

Sous une version LT, que se soit pour l'une ou l'autre solution proposée, il te faudra acquérir LT-Extender" pour pouvoir utiliser ceux-ci. Ceci sous réserve d'une bonne compatibilité de ce Soft (je ne le connais pas du tout!). Autrement sur une LT une bidouille: voir ma réponse Disons que tu auras plus de chance de me voir à cet heure là, qu'à 5h du mat' :P

Merci pour l'image (gile) ;) L'idée m'est venu d'ici , j'ai juste repris complètement la définition des formes et du type de ligne. Lili2006 Ton fichier LIN tu l'as fais par un copier-coller, (un espace apres "S=" est indésirable) Tu peux le prendre au même endroit que les SHX. Autrement je vois pas. :casstet:

Bon, je vois que le copier-coller pose des problèmes :( Vous pouvez obtenir les SHX directement ici

Une personnalisation un peu "fun"... Donc pour la mettre en application, emboitez moi le pas. ;) mettre ce qui suit dans un fichier nommé "Right-Foot.shp" *139,194,RIGHT-FOOT 2,8,(67,-2),1,13,(-35,0,14),(-31,-30,36),(14,-30,46),(37,-12,7),(56,-11,0), (48,-15,-8),(37,6,35),(7,10,19),(9,12,-19),(21,17,0),(-10,50,76),(-35,5,13) , (-14,-7,26),(-11,-51,27),(-3,-7,-42),(-12,-5,0),(-34,14,-50),(-44,54,21),(0 ,0), 2,8,(93,-56),8,(59,-56),1,13,(5,4,0),(-2,6,67),(-17,5,11),(-4,-5,69),(6,-8, 0), (12,-2,47),(0,0),2,8,(27,8),1,13,(-1,10,64),(-19,6,23),(-4,-6,71),(4,-8,0), (20,-2,58),(0,0),2,8,(22,13),1,13,(-1,6,49),(-19,8,28),(-4,-7,80),(8,-11,0), (8,-2,47),(8,6,14),(0,0),2,8,(18,18),1,13,(-1,8,58),(-27,8,21),(-4,-8,75), (13,-12,22),(19,4,36),(0,0),2,8,(0,22),1,13,(5,27,90),(-25,8,12),(-9,-3,37), (-9,-21,19),(7,-10,49),(31,-1,14),(0,0),2,8,(12,53),0 idem dans Left-Foot.shp *140,194,LEFT-FOOT 2,8,(68,2),1,13,(44,55,19),(34,13,-48),(11,-5,0),(3,-7,-46),(10,-49,25),(14,-9, 28),(39,6,12),(6,50,73),(-20,16,0),(-9,12,-18),(-8,11,22),(-38,4,36),(-46,-14, -8),(-56,-11,0),(-37,-12,8),(-14,-30,47),(28,-29,34),(39,-1,16),(0,0),2,8,(89, 63),8,(66,40),1,13,(0,6,75),(-4,3,0),(-12,-3,54),(-5,-7,0),(3,-5,77),(18,6,14), (0,0),2,8,(22,-9),1,13,(1,10,62),(-20,-3,61),(-4,-7,0),(5,-6,78),(18,6,13),(0, 0),2,8,(22,-9),1,13,(0,7,55),(-7,5,12),(-8,-2,46),(-8,-11,0),(6,-7,88),(17,8, 10),(0,0),2,8,(18,-20),1,13,(1,8,59),(-21,3,43),(-11,-11,20),(4,-8,76),(27,8, 20),(0,0),2,8,(6,-41),1,13,(-4,27,85),(-32,-1,15),(-7,-10,48),(9,-21,20),(10,-3, 41),(24,8,12),(0,0),2,8,(7,-26),0 Avec la commande COMPILER d'Autocad faites les fichiers SHX correspondant que vous placerez dans un dossier de recherche. Dans ce même dossier créer un nouveau fichier nommé "Footsteps.lin" qui contiendra ceci *Pied-nu, Trace-pieds-nus A,0,[left-foot,left-foot.shx,S=0.001],-0.25,0,[right-foot,right-foot.shx,S=0.001],-0.25,0 Prenez votre pied! :D NB: Un intrus lors du collage dans le 1er < br /> Aucun espace ne doit subsister après les copiés-collés, cela entrainerait une erreur de compilation.

Essayes (toujours dans les options) de te créer un nouveau profil et de le rendre courant. Si dans ce nouvel environnement, tes propriétés fonctionnent cela voudrait dire qu'une personnalisation c'est mal passé et à foutu le "bazard" dans ton précédent profil.

Un extrait de l'aide (que j'ai toujours du mal à comprendre) à propos du calcul d'un axe arbitraire A tes neurones ;)

A priori y'a pas de raison! Je te suggère de tracer dans ce même dessin (pour tester) une spline assez tendue et de la décaler. Si ça fonctionne, c'est que ton autre spline a des courbures trop prononcées proche de ta valeur de décalage... Tu peut essayer aussi de faire un SCU origine près de ta spline à décaler, si celle ci est très éloignée de l'origine, puis lancer un décalage. Pas d'autres suggestions...

Je pense que tu t'adresse à moi... Autocad à 2 manières de fonctionnement "Sélection -> Verbe" ou "Verbe -> Sélection" (méthode originale par le clavier sur toute version) Si au message vierge de "commande: " d'autocad tu fais un Glisser/Lacher sur des entités graphiques ou simple click sur une seule entité, tu vas activer sois une surbrillance, soit l'activation des poignées sur les entité (voir variable "PICKFIRST") Si c'est la surbrillance tu seras en mode "Sélection -> Verbe", tu lanceras ta commande d'édition APRES ta sélection. Si c'est les poignées tu active un grip en cliquant sur un de ceux-ci (choisir de préférence le point de base directement) et soit avec la barre d'espace, tu fais succéder les commande possibles avec leurs options), soit du choisi directement dans le menu contextuel du click-droit l'action désirée. (Attention à la variable "SHORTCUTMENU") NB:Avec les grips ont peut aussi changer la sélection de calque/couleur/etc... directement dans la barre de gestion (je ne parle pas de la fenêtre de propriétées)

Ou tout simplement avec les Grips (poignées), l'option "Copier" en mode Rotation. Cela avec toute version... Il y a aussi le "MOCORO.ARX" des express (MOve,COpy,ROtate) Moi je vote pour les "Grips", on peut changer le point de base de rotation à tout moment.

A une époque, un certain DLL d'autocad avec l'emploi d'un anti-virus (Kapersky sans le nommer), faisait planter Autocad. Il fallait mettre à jour ce DLL (chez Autodesk ou Kapersky, je ne sais plus) pour éviter les erreurs. Je ne pense pas que ce soit ton problème, mais comme tu n'as pas beaucoup de réponses... A tout hasard, essayes aussi de reprendre ce dessin en créant un nouveau profil (arg), sait on jamais.

Lilli2006, Un SUJET similaire d'automatisation de sortie, si ça peut te donner un point de départ...

Salut ribbit, J'ai failli passé à coté de ton message, Alors le format ECW de l'IGN que j'utilise est géoréférencé. Merci de l'info bien sur, c'est fait pour, le code est grossier, je l'ai fais à la volée pour constitué mon gabarit. Puisque je veux pouvoir le gérer, j'ai appliqué ces quelque lignes après l'insertion des images. NB: Adaptez le chemin des images dans le code... (setq js (ssget "_x" '((0 . "IMAGE"))) n 0) (repeat (sslength js) (setq e_name (ssname js n)) ; (setq e_name (entlast)) (setq pt (cdr (assoc 10 (entget e_name)))) (setq name (cdr (assoc 1 (entget (cdr (assoc 340 (entget e_name))))))) (setq l_cur (getvar "CLAYER")) (setvar "CLAYER" "DefPoints") (command "_.text" "_bleft" "_none" pt "100" "0" name) (command "_rectang" "_none" pt "_none" "@40000,30000") (setvar "CLAYER" l_cur) (command "_.-image" "_detach" (vl-string-subst "" ".tif" (vl-string-subst "" "D:\\SCAN_25\\" name))) (setq n (1+ n)) ) Je met un cadre et un texte à chaque images sur le calque "DefPoints", ce qui me permet de toujours voir mes références d'images (chargées ou non) sans que ces infos soient imprimées. Ainsi dans mon prototype ainsi constitué je peux utiliser la routine suivante pour gérer le chargement des images par pointage sur le texte de référence. (defun c:scan25 ( / js dxf_ent name-image) (while (not (setq js (ssget "_+.:E:S" '((0 . "TEXT") (67 . 0) (410 . "Model") (8 . "Defpoints") (62 . 1) (100 . "AcDbText")))))) (setq dxf_ent (entget (ssname js 0))) (setq name-image (substr (cdr (assoc 1 dxf_ent)) 11 8)) (initget "Recharge Decharge _Reload Unload") (if (eq (getkword (strcat "\n[Recharge/Decharge] l'image " name-image " : ")) "Reload") (command "_.-image" "_reload" name-image) (command "_.-image" "_unload" name-image) ) )

Je crois bien que c'est nécessaire si je m'en référe à l'aide Création et affichage de bibliothèques de clichés Concepts Procédures Référence Une bibliothèque de clichés est un fichier contenant un ou plusieurs clichés. Les fichiers de bibliothèque de clichés vous permettent de créer des menus de mosaïques d'images personnalisés et de combiner plusieurs fichiers de clichés afin de les gérer plus facilement. Vous pouvez créer des bibliothèques de clichés à l'aide de l'utilitaire SLIDELIB. Après avoir créé une bibliothèque de clichés, vous pouvez afficher les clichés en indiquant le nom de la bibliothèque et du cliché. Ne supprimez pas les clichés originaux après avoir créé la bibliothèque. En effet, SLIDELIB ne peut pas mettre à jour une bibliothèque de clichés existante. Pour ajouter ou supprimer un fichier, vous devez mettre à jour le fichier de liste des clichés, puis recréer une bibliothèque à l'aide de SLIDELIB. Lorsque vous recréez une bibliothèque, tous les fichiers clichés que vous désirez y inclure doivent être disponibles. Encore un extrait de l'aide SLIDELIB (Utilitaire) Compile les fichiers clichés répertoriés dans un fichier ASCII vers un fichier bibliothèque de clichés. Vous pouvez créer des fichiers de bibliothèque de clichés (SLB) à partir de fichiers cliché (SLD) à l'aide de l'utilitaire SLIDELIB fourni dans le répertoire support. La syntaxe de la ligne de commande du système d'exploitation indiquée ci-après permet de construire une bibliothèque de clichés : slidelib library [ < slidelist] où bibliothèque correspond au fichier de bibliothèque de clichés (extension .slb) dans lequel les fichiers cliché (extension .sld) sont ajoutés. slidelist définit la liste des fichiers cliché. Si vous souhaitez ajouter une extension de fichier, choisissez .sld. SLIDELIB Lit une liste de noms de fichiers cliché. Cette liste est normalement fournie en redirigeant une liste de noms de fichiers (un par ligne dans un fichier créé au moyen d'un éditeur de texte ou d'un utilitaire externe) vers l'entrée standard. Les commandes de système d'exploitation ci-dessous créent un fichier slidelist qui peut être utilisé avec SLIDELIB. Tous les fichiers clichés à compiler dans une bibliothèque doivent être placés dans un même dossier. A l'invite DOS (version 5.0 ou ultérieure), entrez : dir *.sld /b > mylist Cette commande crée le fichier mylist que vous pouvez transmettre à SLIDELIB. Vous pouvez aussi créer le fichier mylist à l'aide d'un éditeur de texte en indiquant les noms des fichiers cliché (et les chemins d'accès, si nécessaire), par exemple : lobby, d:\slides\office et \aec\slides\stairs. Le nom du fichier cliché est enregistré dans le fichier bibliothèque, mais sans les informations de disque et de dossier. Etant donné que seul le nom de fichier est inclus, une bibliothèque peut contenir des clichés portant le même nom et provenant de répertoires différents. Cependant, AutoCAD ne pourra accéder qu'à un seul d'entre eux. Pour générer la bibliothèque de clichés mlib à partir de mylist, entrez : slidebib mlib < mylist Cette entrée crée le fichier mlib.slbcontenant le nom et la définition des clichés figurant dans le fichier mylist. Avertissement ! Ne supprimez pas les clichés d'origine. En effet, SLIDELIB ne peut pas mettre à jour une bibliothèque de clichés existante. Pour ajouter ou supprimer un cliché, mettez à jour le fichier slidelist et recréez la bibliothèque à l'aide de l'utilitaire SLIDELIB. Vous aurez alors besoin de tous les clichés originaux. Donc ce qu'expliquait Patrick_35 reste valable aussi pour la commande SLIDELIB En résumé mon lisp va te servir a créer le fichier script (SCR) , qui lui créera les clichés (SLD) de tous les dessins d'un dossier (choisi par l'utilisateur). Ce qui rend obsolète la remarque sur les clichés originaux de l'aide. Ensuite avec les explications données sur le filtre "> " de redirection DOS tu recrée ton fichier biblithèque (SLB) rapidement. NB: Je me sert aussi des SLB pour des boites de dialogue personnalisées en DCL

Tu as omis de garder une ligne concernant l'initialisation des variables (setq nb_ent 0 n -1) En le tournant à ton désir, on peut supprimer 2 variables qui ne servent plus (dis_ref & key) et en modification rapide, cela donnerai: (defun c:del_line_by_dist ( / js nb_ent n ent dxf_ent lst dxf_10 dxf_11 dis_ent) (setq js (ssget "_X" '((0 . "LINE,LWPOLYLINE")))) (cond (js (setq nb_ent 0 n -1) (repeat (sslength js) (setq ent (ssname js (setq n (1+ n))) dxf_ent (entget ent) ) (cond ((eq (cdr (assoc 0 dxf_ent)) "LINE") (setq dxf_10 (cdr (assoc 10 dxf_ent)) dxf_11 (cdr (assoc 11 dxf_ent)) ) ) ((and (eq (cdr (assoc 0 dxf_ent)) "LWPOLYLINE") (eq (cdr (assoc 90 dxf_ent)) 2) ) (setq lst (mapcar '(lambda (x) (trans x ent 1)) (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) dxf_ent))) dxf_10 (car lst) dxf_11 (cadr lst) ) ) (T (setq dxf_10 nil dxf_11 nil)) ) (if (and dxf_10 dxf_11) (progn (setq dis_ent (distance (list (car dxf_10) (cadr dxf_10)) (list (car dxf_11) (cadr dxf_11)))) (if (= dis_ent 0.0) (progn (entdel ent) (setq nb_ent (1+ nb_ent)) ) ) ) ) ) (print nb_ent) (princ " Ligne(s) ont été effacées!.") ) (T (princ "\nAucune ligne trouvée!")) ) (prin1) )

Ça me fais un peu penser à une pub bancaire le "GROS POUCE". ;) Merci, l'essentiel est que tu ais résolu ton problème!

En retard, et un peu hors sujet mais ça pourra peut être servir... Quelque ligne code qui vont permettre de créer tous les clichés des DWG d'un dossier bibliothèque. Donc pratique si on veut régénérer rapidement sa bibli de clichés SLB et/ou que l'on a pas garder tous les SLD. Les dessins devront être "propres" (un zoom étendu est exécuté avant de prendre le cliché) Je pense que les utilitaires de scripts qu'on trouve sur CadXp peuvent faire la même chose ;) (defun c:make_slide ( / prefix file_scr) (setq prefix (strcat (vl-filename-directory (getfiled "Sélectionner un fichier dessin TEMOIN" "" "dwg" 16)) "\\") file_scr (open (strcat prefix "open_folder.scr") "w") ) (foreach dwg (vl-directory-files prefix "*.dwg" 1) (write-line "_.open" file_scr) (write-line (strcat "\"" prefix dwg "\"") file_scr) (write-line "_.zoom" file_scr) (write-line "_extent" file_scr) (write-line "_.mslide" file_scr) (write-line (strcat "\"" prefix (substr dwg 1 (- (strlen dwg) 4)) "\"") file_scr) (write-line "_.close" file_scr) (write-line "_yes" file_scr) ) (close file_scr) (princ (strcat "\Vous pouvez lancer le SCRIPT :" prefix "open_folder.scr")) (prin1) ) La procédure peut être lancée depuis un nouveau dessin.

Un lien parmi d'autre sur ce sujet maintes fois répété.