djameleddine

merci lili2006 pour ton aide

:exclam: une fois ça m'est arriviez ce que j'ai fait, j'ai réinstaller mon AutoCAD en s'assurant qu'il faut supprimé le dossier C:\Documents and Settings\All Users\Application Data\Autodesk et en fessant une sauvegarde bien sur, bon courage

bonjour tout le monde je suis a la recherche d'un Lisp pour la création d'un maniere automatique un carroyage sous AutoCAD 2006. Merci

bonjour l'ami voici la solution pour ton probleme j'ai un lisp qui génère des talus sous AutoCAD voici le lisp talus.lsp (defun talerr (ch / ) (cond ((eq ch "Function cancelled") nil) ((eq ch "quit / exit abort") nil) ((eq ch "console break") nil) (T (princ ch)) ) (setq *error* olderr) (command "_.undo" "_end") (command "_.u") (if (<= sv_und 3) (command "_.undo" "_control" "_one")) (setvar "cmdecho" 1) (princ) ) (defun tststr (chaine / chaine) (if (wcmatch chaine "*[`?`,```*\\\"<>/=|:]*") (progn (set_tile "error" "Nom de plan incorrect !") (set_tile "pl_tal" pl_tal) ) (progn (setq pl_tal chaine) (set_tile "error" "") ) ) ) (defun tstval (val idx_v / val idx_v) (if (distof val) (progn (if idx_v (setq g_barb (distof val)) (setq e_barb (distof val)) ) (set_tile "error" "") ) (progn (set_tile "error" "Valeur numérique incorrecte !") (if idx_v (set_tile "g_barb" (rtos g_barb)) (set_tile "e_barb" (rtos e_barb)) ) ) ) ) (defun getindex (item itemlist / m n) (setq n (length itemlist)) (if (> (setq m (length (member item itemlist))) 0) (- n m) nil ) ) (defun colorname (colnum) (setq cn (abs colnum)) (cond ((= cn 1) "rouge") ((= cn 2) "jaune") ((= cn 3) "vert") ((= cn 4) "cyan") ((= cn 5) "bleu") ((= cn 6) "magenta") ((= cn 7) "blanc") (T (itoa cn)) ) ) (defun makelaylists (/ layname onoff frozth color linetype vpf vpn ss cvpname xdlist vpldata sortlist name templist bit-70 ) (if (= (setq tilemode (getvar "tilemode")) 0) (progn (setq ss (ssget "_x" (list (cons 0 "VIEWPORT") (cons 69 (getvar "CVPORT")) ) ) ) (setq cvpname (ssname ss 0)) (setq xdlist (assoc -3 (entget cvpname '("acad")))) (setq vpldata (cdadr xdlist)) ) ) (setq sortlist nil) (setq templist (tblnext "LAYER" T)) (while templist (setq name (cdr (assoc 2 templist))) (setq sortlist (cons name sortlist)) (setq templist (tblnext "LAYER")) ) (if (>= (getvar "maxsort") (length sortlist)) (setq sortlist (acad_strlsort sortlist)) (setq sortlist (reverse sortlist)) ) (setq laynmlst sortlist) (setq longlist nil) (setq layname (car sortlist)) (while layname (setq laylist (tblsearch "LAYER" layname)) (setq color (cdr (assoc 62 laylist))) (if (minusp color) (setq onoff ".") (setq onoff "AC") ) (setq color (abs color)) (setq colname (colorname color)) (setq bit-70 (cdr (assoc 70 laylist))) (if (= (logand bit-70 1) 1) (setq frozth "F" fchk laylist) (setq frozth ".") ) (if (= (logand bit-70 2) 2) (setq vpn "N") (setq vpn ".") ) (if (= (logand bit-70 4) 4) (setq lock "L") (setq lock ".") ) (setq linetype (cdr (assoc 6 laylist))) (setq layname (substr layname 1 31)) (if (= tilemode 0) (progn (if (member (cons 1003 layname) vpldata) (setq vpf "C") (setq vpf ".") ) ) (setq vpf ".") ) (setq ltabstr (strcat layname "\t" onoff "\t" frozth "\t" lock "\t" vpf "\t" vpn "\t" colname "\t" linetype)) (setq longlist (append longlist (list ltabstr))) (setq sortlist (cdr sortlist)) (setq layname (car sortlist)) ) ) (defun getlayer (/ old-idx layname on off frozth linetype colname) (if (not (new_dialog "setlayer" dcl_id)) (exit)) (makelaylists) (if (= lay-idx ()) (setq lay-idx (getindex (getvar "clayer") laynmlst)) ) (start_list "list_lay") (mapcar 'add_list longlist) (end_list) (setq old-idx lay-idx) (if (/= lay-idx nil) (laylist_act (itoa lay-idx))) (set_tile "cur_layer" (getvar "clayer")) (action_tile "list_lay" "(laylist_act $value)") (action_tile "edit_lay" "(layedit_act $value)") (action_tile "accept" "(test-ok)") (action_tile "cancel" "(reset-lay)") (if (= (start_dialog) 1) (progn (if (= lay-idx nil) (setq layname "Divers")) (set_tile "t_layer" layname) (if (= lt-idx 0) (set_tile "t_ltype" (bylayer_lt)) ) (if (= ecolor 256) (progn (set_tile "t_color" (bylayer_col)) (col_tile "show_image" cn nil) ) ) layname ) elayer ) ) (defun test-ok ( / errtile) (setq errtile (get_tile "error")) (cond ( (= errtile "") (done_dialog 1) (set_tile "pl_tal" layname) ) ) ) (defun reset-lay () (setq lay-idx old-idx) (done_dialog 0) (set_tile "pl_tal" pl_tal) (setq elayer pl_tal) ) (defun laylist_act (index / layinfo color dashdata) (set_tile "error" "") (setq lay-idx (atoi index)) (setq layname (nth lay-idx laynmlst)) (setq layinfo (tblsearch "layer" layname)) (setq color (cdr (assoc 62 layinfo))) (setq color (abs color)) (setq colname (colorname color)) (set_tile "list_lay" (itoa lay-idx)) (set_tile "edit_lay" layname) (mode_tile "list_lay" 2) ) (defun layedit_act (layvalue) (setq layvalue (strcase layvalue)) (if (setq lay-idx (getindex layvalue laynmlst)) (progn (set_tile "error" "") (laylist_act (itoa lay-idx)) ) (progn (set_tile "error" "Nom de Plan Incorrect.") (setq lay-idx old-idx) ) ) ) (defun tlcplx (drp / ) (mode_tile t_mode 4) (setq t_mode $key) (mode_tile t_mode 4) (if (= t_mode "mod_tal") (progn (set_tile "cmplx" "0") (setq t_cplx "0") (mode_tile "cmplx" 1) ) (progn (set_tile "cmplx" drp) (mode_tile "cmplx" 0) ) ) ) (defun c:talus ( / sv_blp sv_osm sv_pdm sv_sor sv_ucs sv_und ajus_t t_mode pl_tal t_cplx p_barb g_barb e_barb em_brb gm_brb pm_brb last_e nam_pl l_ptcr nb_rep l_ptdc l_ptds ent_cr typ_en dcl_id what_next tal_lst pt_pd ent_pd n_i key v1 v2 det_or ang_sp js_ok js_pd cod nom nb_barb lg_seg pt p_prec pt_tst count) (setvar "cmdecho" 0) (if (<= (setq sv_und (getvar "undoctl")) 3) (command "_.undo" "_control" "_all")) (command "_.undo" "_group") (setq olderr *error* *error* talerr) (setq last_e (entlast)) (setq sv_blp (getvar "blipmode")) (setvar "blipmode" 0) (setq sv_osm (getvar "osmode")) (setvar "osmode" 0) (setq sv_pdm (getvar "pdmode")) (if (/= sv_pdm 0) (setvar "pdmode" 0)) (setq sv_sor (getvar "sortents")) (setvar "sortents" 3) (setq sv_ucs (getvar "worlducs")) (if (= sv_ucs 0) (command "_.ucs" "")) (setq nam_pl (getvar "clayer")) (if (/= (substr (getvar "users2") 1 7) "mod_tal") (progn (setvar "userr1" 1.5) (setvar "userr2" 4.5) (setvar "userr3" 1.0) (setvar "users1" "1") (setvar "users2" "mod_tal3") (setvar "users3" "TALUS") (setvar "users4" "0") ) ) (setq pm_brb (getvar "userr1") gm_brb (getvar "userr2") em_brb (getvar "userr3") ajus_t (getvar "users1") t_mode (getvar "users2") pl_tal (getvar "users3") t_cplx (getvar "users4") ) (setq p_barb pm_brb g_barb gm_brb e_barb em_brb l_ptcr () nb_rep 0 l_ptdc () l_ptds ()) (while (null (setq ent_cr (entsel "\nCliquer la crête de talus !")))) (setq typ_en (cdr (assoc 0 (entget (car ent_cr))))) (cond ((or (= typ_en "LINE") (= typ_en "ARC") (= typ_en "SPLINE") (= typ_en "CIRCLE") (= typ_en "ELLIPSE") (= typ_en "LWPOLYLINE") (= typ_en "POLYLINE") ) (setq dcl_id (load_dialog "talus")) (setq what_next 3) (while (< 1 what_next) (if (not (new_dialog "talus" dcl_id)) (exit)) (set_tile "cmplx" t_cplx) (set_tile "pl_tal" pl_tal) (set_tile "g_barb" (rtos g_barb)) (set_tile "e_barb" (rtos e_barb)) (set_tile "ajust" ajus_t) (set_tile "error" "") (setq tal_lst '("tal0" "tal1" "tal2" "tal3" "tal4" "tal")) (foreach img tal_lst (start_image (strcat "mod_" img)) (slide_image 0 0 (- (dimx_tile (strcat "mod_" img)) 1) (- (dimy_tile (strcat "mod_" img)) 1) (strcat "talus(" img ")") ) (end_image) ) (mode_tile t_mode 2) (mode_tile t_mode 4) (if (= t_mode "mod_tal") (progn (setq t_cplx "0") (mode_tile "cmplx" 1) ) (progn (mode_tile "cmplx" 0) ) ) (foreach img tal_lst (action_tile (strcat "mod_" img) "(tlcplx t_cplx)") ) (action_tile "pl_tal" "(tststr $value)") (action_tile "pl_name" "(setq pl_tal (getlayer))") (action_tile "g_barb" "(tstval $value T)") (setq p_barb (/ g_barb 3)) (action_tile "pick_g" "(done_dialog 2)") (action_tile "e_barb" "(tstval $value nil)") (action_tile "pick_e" "(done_dialog 3)") (action_tile "ajust" "(setq ajus_t $value)") (action_tile "cmplx" "(setq t_cplx $value)") (action_tile "accept" "(done_dialog 1)") (action_tile "cancel" "(done_dialog 0)") (setq what_next (start_dialog)) (cond ((= what_next 2) (initget 91) (setq g_barb (getdist (cadr ent_cr) "\nLongueur des barbes les plus longues: ")) ) ((= what_next 3) (initget 91) (setq e_barb (getdist (cadr ent_cr) "\nEspacement des barbes: ")) ) ) ) (unload_dialog dcl_id) (cond ((not (zerop what_next)) (command "_.measure" (car ent_cr) e_barb) (while (and (= (cdr (assoc 0 (entget (entlast)))) "POINT") (not (equal (entlast) last_e)) ) (setq l_ptcr (cons (cdr (assoc 10 (entget (entlast)))) l_ptcr)) (entdel (entlast)) ) (cond ((and l_ptcr (> (length l_ptcr) 1)) (setq ent_pd nil typ_en nil) (princ "\nCliquer le pied de talus !") (while (or (null ent_pd) (not (member typ_en '("LINE" "ARC" "SPLINE" "CIRCLE" "ELLIPSE" "LWPOLYLINE" "VERTEX")))) (setq n_i 0) (while (/= (car (setq key (grread T 4 2))) 3) (cond ((/= (car key) 25) (grdraw (car l_ptcr) (cadr key) -1) (if (zerop n_i) (grdraw (car l_ptcr) (cadr key) -1)) (setq n_i 1) ) (T (setq n_i 0)) ) ) (setq ent_pd (nentselp (cadr key))) (cond ((car ent_pd) (setq ent_pd (entget (car ent_pd)) typ_en (cdr (assoc 0 ent_pd))) (if (not (member typ_en '("LINE" "ARC" "SPLINE" "CIRCLE" "ELLIPSE" "LWPOLYLINE" "VERTEX"))) (princ "\nLe pied de talus n'est pas une polyligne, spline, ligne, arc, cercle ou ellipse! ") ) ) ) ) (if (eq typ_en "VERTEX") (redraw (cdr (assoc 330 ent_pd)) 3) (redraw (cdar ent_pd) 3) ) (setq v1 (mapcar '- (cadr l_ptcr) (car l_ptcr)) v2 (mapcar '- (cadr key) (car l_ptcr)) det_or (apply '(lambda (x1 y1 z1 x2 y2 z2) (- (* x1 y2) (* y1 x2))) (append v1 v2)) ) (cond ((> det_or 0.0) (setq ang_sp (/ pi 2))) ((< det_or 0.0) (setq ang_sp (- (/ pi 2)))) (T (setq ang_sp nil l_ptcr ()) (prompt "\nImpossible d'orienter les barbes de talus") (exit)) ) (setq js_pd (ssadd)) (prompt "\nChoix de seuils supplémentaires : ") (setq js_pd (ssget '( (-4 . " (-4 . "") (-4 . "") (-4 . "") (-4 . "") (-4 . "") (-4 . "") (-4 . "") (-4 . "OR>") ) ) ) (if (null js_pd) (setq js_pd (ssadd))) (ssadd (cdar ent_pd) js_pd) (if (eq typ_en "VERTEX") (redraw (cdr (assoc 330 ent_pd)) 4) (redraw (cdar ent_pd) 4) ) (setq l_ptdc ()) (if (zerop (sslength js_pd)) (setq ajus_t "0")) (if (= (setq cod (tblsearch "layer" pl_tal)) ()) (command "_.layer" "_new" pl_tal "_color" 15 pl_tal "_set" pl_tal "") (progn (setq nom (cdr (assoc 2 cod))) (cond ((= (boole 1 7 (cdr (assoc 70 cod))) 1) (command "._layer" "_thaw" nom "") ) ((= (boole 1 7 (cdr (assoc 70 cod))) 2) (command "._vplayer" "_thaw" nom "" "") ) ((= (boole 1 7 (cdr (assoc 70 cod))) 3) (command "._layer" "_thaw" nom "") (command "._vplayer" "_thaw" nom "" "") ) ((= (boole 1 7 (cdr (assoc 70 cod))) 4) (command "._layer" "_unlock" nom "") ) ((= (boole 1 7 (cdr (assoc 70 cod))) 5) (command "._layer" "_unlock" nom "_thaw" nom "") ) ((= (boole 1 7 (cdr (assoc 70 cod))) 6) (command "._layer" "_unlock" nom "") (command "._vplayer" "_thaw" nom "" "") ) ((= (boole 1 7 (cdr (assoc 70 cod))) 7) (command "._vplayer" "_thaw" nom "" "") (command "._layer" "_unlock" nom "_thaw" nom "") ) ) (setvar "CLAYER" pl_tal) ) ) (setq p_barb (/ g_barb 3)) (setvar "userr1" p_barb) (setvar "userr2" g_barb) (setvar "userr3" e_barb) (setvar "users1" ajus_t) (setvar "users2" t_mode) (setvar "users3" pl_tal) (setvar "users4" t_cplx) (cond ((or (eq t_mode "mod_tal0") (eq t_mode "mod_tal")) (setq nb_barb 0)) ((eq t_mode "mod_tal1") (setq nb_barb 2)) ((eq t_mode "mod_tal2") (setq nb_barb 3)) ((eq t_mode "mod_tal3") (setq nb_barb 4)) ((eq t_mode "mod_tal4") (setq nb_barb 5)) ) (while (cadr l_ptcr) (cond ((zerop nb_barb) (setq lg_seg g_barb)) (T (if (zerop (rem nb_rep nb_barb)) (setq lg_seg g_barb) (setq lg_seg p_barb) ) ) ) (cond ((zerop nb_rep) (setq pt (polar (car l_ptcr) (+ (angle (car l_ptcr) (cadr l_ptcr)) ang_sp) lg_seg) p_prec (car l_ptcr)) ) (T (setq pt (polar (car l_ptcr) (+ (angle p_prec (cadr l_ptcr)) ang_sp) lg_seg) p_prec (car l_ptcr)) ) ) (if (eq t_mode "mod_tal") (command "_.pline" (car l_ptcr) "_width" (/ e_barb 2) "0.0" pt "") (command "_.line" (car l_ptcr) pt "") ) (if (eq ajus_t "1") (progn (setvar "OSMODE" 1) (setq pt_tst (cdr (assoc 11 (entget (entlast))))) (command "_.trim" js_pd "" (list (entlast) pt) "") (if (not (equal (cdr (assoc 11 (entget (entlast)))) pt_tst)) (setq pt T) ) (setvar "OSMODE" 0) ) ) (if (= t_cplx "1") (if (eq lg_seg g_barb) (setq l_ptdc (cons pt l_ptdc)) ) ) (setq l_ptcr (cdr l_ptcr) nb_rep (1+ nb_rep)) (cond ((and (eq (length l_ptcr) 1) (not (equal (car l_ptcr) p_prec))) (setq l_ptcr (cons (car l_ptcr) l_ptcr)) ) ((and (eq (length l_ptcr) 1) (equal (car l_ptcr) p_prec)) (while (> (length l_ptdc) 1) (cond ((and (listp (car l_ptdc)) (listp (cadr l_ptdc))) (setq l_ptds (cons ((lambda (l) (list (/ (+ (caar l) (caadr l)) 2.0) (/ (+ (cadar l) (cadadr l)) 2.0) (/ (+ (caddar l) (caddr (cadr l))) 2.0) ) ) (list (car l_ptdc) (cadr l_ptdc)) ) l_ptds ) ) ) ) (setq l_ptdc (cdr l_ptdc)) ) (setq l_ptcr () count 0) (mapcar '(lambda (x) (setq count (1+ count))(if (zerop (rem count 2)) (setq l_ptcr (cons x l_ptcr)))) l_ptds) (setq nb_barb 0 nb_rep 0 l_ptds () ang_sp (- ang_sp)) ) ) ) ) (T (prompt "\nEspacement des barbes trop important pour l'élément sélectionné. ")) ) ) (T (prompt "\n*Arrêt*") talerr) ) ) (T (prompt "\nLa crête de talus n'est pas une polyligne, spline, ligne, arc, cercle ou ellipse! ")) ) (setvar "blipmode" sv_blp) (setvar "osmode" sv_osm) (setvar "sortents" sv_sor) (setvar "clayer" nam_pl) (if (/= sv_pdm 0) (setvar "pdmode" sv_pdm)) (if (= sv_ucs 0) (command "_.ucs" "_p")) (setq *error* olderr) (command "_.undo" "_end") (if (<= sv_und 3) (command "_.undo" "_control" "_one")) (setvar "cmdecho" 1) (prin1) ) voici sont dcl talus.dcl talus : dialog { label = "Définition des Talus"; : boxed_row { label = "Choix du Type de Talus"; : image_button { key = "mod_tal0"; width = 5; fixed_width = true; aspect_ratio = 1.0; color = 0; } : image_button { key = "mod_tal1"; width = 5; fixed_width = true; aspect_ratio = 1.0; color = 0; } : image_button { key = "mod_tal2"; width = 5; fixed_width = true; aspect_ratio = 1.0; color = 0; } : image_button { key = "mod_tal3"; width = 5; fixed_width = true; aspect_ratio = 1.0; color = 0; } : image_button { key = "mod_tal4"; width = 5; fixed_width = true; aspect_ratio = 1.0; color = 0; } : image_button { key = "mod_tal"; width = 5; fixed_width = true; aspect_ratio = 1.0; color = 0; } } :boxed_column { label = "Choix du Calque de Conception des Talus"; :edit_box { label = "Calque:"; mnemonic = "C"; key = "pl_tal"; width = 32; edit_width = 32; edit_limit = 31; } : button { label = "Choix dans Liste des calques..."; mnemonic = "L"; key = "pl_name"; fixed_width = true; alignment = centered; } } :column { label = "Dimensionnement des barbes"; alignment = left; : row { : edit_box { label = "Barbes-Longueur :"; mnemonic = "L"; key = "g_barb"; edit_width = 10; } : button { label = "Saisir <"; mnemonic = "S"; key = "pick_g"; } } : row { : edit_box { label = "Barbes-Espacement:"; mnemonic = "E"; key = "e_barb"; edit_width = 10; } : button { label = "Saisir <"; mnemonic = "S"; key = "pick_e"; } } : row { : toggle { label = "Ajustement des Barbes"; mnemonic = "A"; key = "ajust"; } : toggle { label = "Talus complexe"; mnemonic = "T"; key = "cmplx"; } } } ok_cancel_err; } setlayer : dialog { subassembly = 0; label = "Choix du Calque"; initial_focus = "listbox"; : concatenation { children_fixed_width = true; key = "clayer"; : text_part { label = "Calque Courant: "; } : text_part { key = "cur_layer"; width = 35; } } : row { fixed_width = true; key = "titles"; children_fixed_width = true; : text { label = "Nom du Calque"; width = 34; } : text { label = "Etat"; width = 9; } : text { label = "Couleur"; width = 8; } : text { label = "Type de ligne"; width = 12; } } : list_box { tabs = "32 35 37 39 41 44 53"; width = 67; height = 12; key = "list_lay"; allow_accept = true; } : row { key = "controls"; : column { key = "lname"; fixed_width = true; : edit_box { label = "Définir le Nom du Calque:"; mnemonic = "D"; key = "edit_lay"; width = 32; edit_width = 32; edit_limit = 31; allow_accept = true; } } } ok_cancel_err; }

Bonjour tout le monde. Voici une solution en programme lisp pour charger un semi de point en format .txt sous AutoCAD, écrit sous la forme : Numéro X Y Z code voici le lisp topo.lsp (defun toperr (ch / sv_cmd sv_sty a b ech plnw1 plnw2 plnw3 num_ok alt_ok drp_pt drp_sp dcl_id coma what_der xxx what_next cnt znul biz htx num dx dy alt pt nb nw_car carac chaine pl_nam m n layname onoff frozth color linetype vpf vpn ss cvpname xdlist vpldata sortlist name templist bit-70 chn old-idx layname on off frozth linetype colname errtile layinfo color dashdata ) (cond ((eq ch "Function cancelled") nil) ((eq ch "quit / exit abort") nil) ((eq ch "console break") nil) (T (princ ch)) ) (setvar "textstyle" sv_sty) (setvar "cmdecho" sv_cmd) (setq *error* olderr) (princ) ) (defun cv_str (alpha id_c / nb nw_car carac) (setq nb 1 nw_car "") (while (> (strlen alpha) 0) (cond ((wcmatch alpha "*',*") (while (and (/= (substr alpha nb 1) ",") (< nb (strlen alpha))) (setq nb (1+ nb)) ) (setq carac (substr alpha 1 (1- nb))) (if (= id_c "1") (setq nw_car (strcat nw_car (if (/= nw_car "") "." " ") carac)) (setq nw_car (strcat nw_car " " carac)) ) (setq alpha (substr alpha (1+ nb))) ) ) (setq nb 1) ) (setq a nw_car) ) (defun espa (chn / ) (while (eq (substr chn 1 1) " ") (setq chn (substr chn 2)) ) (while (/= (substr chn 1 1) " ") (if (eq (substr chn 1 1) "") (setq chn '" ") (setq chn (substr chn 2)) ) ) ) (defun tstval (val / ) (if (= (type (read val)) 'INT) (progn (setq ech (atoi val)) (set_tile "error" "") ) (progn (set_tile "error" "Valeur entière incorrecte !") (set_tile "c_ech" (itoa ech)) ) ) ) (defun v_chg (index / ) (setq ech (read (nth (atoi index) '("50" "100" "200" "500" "1000" "2000" "2500" "5000" "10000") ) ) ) (set_tile "c_ech" (itoa ech)) ) (defun tststr (chaine k_pl nom_pl / chaine pl_nam) (if (not (wcmatch chaine "*[]` `ý `ø`?`#`@`.`~`[`,`'!%^&()+={}|`\\:;\"<>/]*")) (progn (set nom_pl chaine) (set_tile "error" "") ) (progn (set_tile "error" "Nom de plan incorrect !") (set_tile k_pl (eval nom_pl)) ) ) ) (defun getindex (item itemlist / m n) (setq n (length itemlist)) (if (> (setq m (length (member item itemlist))) 0) (- n m) nil ) ) (defun colorname (colnum) (setq cn (abs colnum)) (cond ((= cn 1) "rouge") ((= cn 2) "jaune") ((= cn 3) "vert") ((= cn 4) "cyan") ((= cn 5) "bleu") ((= cn 6) "magenta") ((= cn 7) "blanc") (T (itoa cn)) ) ) (defun makelaylists (/ layname onoff frozth color linetype vpf vpn ss cvpname xdlist vpldata sortlist name templist bit-70 ) (if (= (setq tilemode (getvar "tilemode")) 0) (progn (setq ss (ssget "_x" (list (cons 0 "VIEWPORT") (cons 69 (getvar "CVPORT")) ) ) ) (setq cvpname (ssname ss 0)) (setq xdlist (assoc -3 (entget cvpname '("acad")))) (setq vpldata (cdadr xdlist)) ) ) (setq sortlist nil) (setq templist (tblnext "LAYER" T)) (while templist (setq name (cdr (assoc 2 templist))) (setq sortlist (cons name sortlist)) (setq templist (tblnext "LAYER")) ) (if (>= (getvar "maxsort") (length sortlist)) (setq sortlist (acad_strlsort sortlist)) (setq sortlist (reverse sortlist)) ) (setq laynmlst sortlist) (setq longlist nil) (setq layname (car sortlist)) (while layname (setq laylist (tblsearch "LAYER" layname)) (setq color (cdr (assoc 62 laylist))) (if (minusp color) (setq onoff ".") (setq onoff "AC") ) (setq color (abs color)) (setq colname (colorname color)) (setq bit-70 (cdr (assoc 70 laylist))) (if (= (logand bit-70 1) 1) (setq frozth "F" fchk laylist) (setq frozth ".") ) (if (= (logand bit-70 2) 2) (setq vpn "N") (setq vpn ".") ) (if (= (logand bit-70 4) 4) (setq lock "L") (setq lock ".") ) (setq linetype (cdr (assoc 6 laylist))) (setq layname (substr layname 1 31)) (if (= tilemode 0) (progn (if (member (cons 1003 layname) vpldata) (setq vpf "C") (setq vpf ".") ) ) (setq vpf ".") ) (setq ltabstr (strcat layname "\t" onoff "\t" frozth "\t" lock "\t" vpf "\t" vpn "\t" colname "\t" linetype)) (setq longlist (append longlist (list ltabstr))) (setq sortlist (cdr sortlist)) (setq layname (car sortlist)) ) ) (defun getlayer (k_pl nom_pl / old-idx layname on off frozth linetype colname) (if (not (new_dialog "setlayer" dcl_id)) (exit)) (makelaylists) (if (= lay-idx ()) (setq lay-idx (getindex (getvar "clayer") laynmlst)) ) (start_list "list_lay") (mapcar 'add_list longlist) (end_list) (setq old-idx lay-idx) (if (/= lay-idx nil) (laylist_act (itoa lay-idx))) (set_tile "cur_layer" (getvar "clayer")) (action_tile "list_lay" "(laylist_act $value)") (action_tile "edit_lay" "(layedit_act $value)") (action_tile "accept" "(test-ok k_pl)") (action_tile "cancel" "(reset-lay k_pl nom_pl)") (if (= (start_dialog) 1) (progn (if (= lay-idx nil) (setq layname "Divers")) (set_tile "t_layer" layname) (if (= lt-idx 0) (set_tile "t_ltype" (bylayer_lt)) ) (if (= ecolor 256) (progn (set_tile "t_color" (bylayer_col)) (col_tile "show_image" cn nil) ) ) layname ) elayer ) ) (defun test-ok (k_pl / errtile) (setq errtile (get_tile "error")) (cond ( (= errtile "") (done_dialog 1) (set_tile k_pl layname) ) ) ) (defun reset-lay (k_pl nom_pl / ) (setq lay-idx old-idx) (done_dialog 0) (set_tile k_pl nom_pl) (setq elayer nom_pl) ) (defun laylist_act (index / layinfo color dashdata) (set_tile "error" "") (setq lay-idx (atoi index)) (setq layname (nth lay-idx laynmlst)) (setq layinfo (tblsearch "layer" layname)) (setq color (cdr (assoc 62 layinfo))) (setq color (abs color)) (setq colname (colorname color)) (set_tile "list_lay" (itoa lay-idx)) (set_tile "edit_lay" layname) (mode_tile "list_lay" 2) ) (defun layedit_act (layvalue) (setq layvalue (strcase layvalue)) (if (setq lay-idx (getindex layvalue laynmlst)) (progn (set_tile "error" "") (laylist_act (itoa lay-idx)) ) (progn (set_tile "error" "Nom de Plan Incorrect.") (setq lay-idx old-idx) ) ) ) (defun c:topo ( / sv_cmd sv_sty a b ech plnw1 plnw2 plnw3 num_ok alt_ok drp_pt drp_sp dcl_id coma what_der xxx what_next cnt znul biz htx num dx dy alt pt chn ) (cond ((/= (getvar "cvport") 1) (setq sv_cmd (getvar "cmdecho")) (setvar "cmdecho" 0) (setq olderr *error* *error* toperr) (setq sv_sty (getvar "textstyle")) (cond ((null (tblsearch "STYLE" "$SPEC-LSP")) (command "._style" "$spec-lsp" "simplex" "0.0" "1.0" "0.0" "_No" "_No" "_No" ) ) ) (setvar "textstyle" "$SPEC-LSP") (setq a (getfiled "Nom du fichier ASCII : " "" "" 4)) (if (= a 1) (progn (setq a "") (while (eq (findfile a) ()) (setq a (getstring "\nNom du fichier ASCII : ")) (if (= a ()) (setq a "")) (if (not (findfile a)) (princ "\nNom de fichier non trouve ou non valable!") ) ) ) ) (cond (a (setq b (open a "r")) (setq a (read-line b)) (setq ech 500 plnw1 "SEMIS" plnw2 "NUMERO" plnw3 "ALTITUDE" num_ok "1" alt_ok "1" drp_pt "0" drp_sp "1" ) (setq dcl_id (load_dialog "topo.dcl")) (if (wcmatch a "*`,*") (setq coma T) (setq coma nil) ) (setvar "pdsize" -0.25) (setq what_der 2) (while (< 1 what_der) (if (not (new_dialog "topo_id" dcl_id)) (exit)) (set_tile "demons" a) (set_tile "coma_pt" drp_pt) (set_tile "coma_sp" drp_sp) (if (not coma) (progn (mode_tile "coma_pt" 1) (mode_tile "coma_sp" 1) ) (progn (mode_tile "coma_pt" 0) (mode_tile "coma_sp" 0) ) ) (set_tile "error" "") (action_tile "coma_pt" "(setq drp_pt $value)") (action_tile "coma_sp" "(setq drp_sp $value)") (action_tile "accept" "(done_dialog 1)") (action_tile "cancel" "(done_dialog 0)") (setq what_der (start_dialog)) (cond ((= what_der 1) (setq what_next 2) (while (< 1 what_next) (if (not (new_dialog "topo" dcl_id)) (exit)) (start_list "lst_ech") (mapcar '(lambda (x) (add_list x) ) '("50" "100" "200" "500" "1000" "2000" "2500" "5000" "10000") ) (end_list) (set_tile "c_ech" (itoa ech)) (set_tile "k_num" num_ok) (set_tile "k_alt" alt_ok) (set_tile "pl_sem" plnw1) (set_tile "pl_num" plnw2) (set_tile "pl_alt" plnw3) (set_tile "error" "") (action_tile "lst_ech" "(v_chg $value)") (action_tile "c_ech" "(tstval $value)") (action_tile "k_num" "(mode_tile \"pl_num\" (- 1 (atoi (setq num_ok $value)))) (mode_tile \"pln_num\" (- 1 (atoi $value)))" ) (action_tile "k_alt" "(mode_tile \"pl_alt\" (- 1 (atoi (setq alt_ok $value)))) (mode_tile \"pln_alt\" (- 1 (atoi $value)))" ) (action_tile "pl_sem" "(tststr $value \"pl_sem\" 'plnw1)") (action_tile "pln_sem" "(setq plnw1 (getlayer \"pl_sem\" plnw1))") (action_tile "pl_num" "(tststr $value \"pl_num\" 'plnw2)") (action_tile "pln_num" "(setq plnw2 (getlayer \"pl_num\" plnw2))") (action_tile "pl_alt" "(tststr $value \"pl_alt\" 'plnw3)") (action_tile "pln_alt" "(setq plnw3 (getlayer \"pl_alt\" plnw3))") (action_tile "mod_pt" "(done_dialog 2)") (action_tile "accept" "(done_dialog 1)") (action_tile "cancel" "(done_dialog 0)") (setq what_next (start_dialog)) (cond ((= what_next 2) (c:ddptype) ) ((= what_next 1) (setq cnt 0 znul 0 biz 0 htx (/ ech 500.0)) (if coma (cv_str a drp_pt)) (princ "\nConstitution du semis cote en cours !\n") (while a (setq num () dx () dy () alt ()) (cond ((/= a ()) (if (eq (type (read a)) 'INT) (setq num (read a)) (setq dx (read a) num ()) ) (setq a (espa a)) (if num (setq dx (read a)) (setq dy (read a))) (setq a (espa a)) (if dy (setq alt (read a)) (setq dy (read a))) (if (eq alt ()) (setq a (espa a) alt (read a))) ) ) (if (/= (type dx) 'REAL) (setq dx ())) (if (/= (type dy) 'REAL) (setq dy ())) (if (/= (type alt) 'REAL) (setq alt 0.0)) (if (and dx dy) (setq pt (cons dx (cons dy (list alt)))) ) (if pt (progn (setq cnt (1+ cnt)) (if (eq (rtos alt 2 3) "0.000") (setq znul (1+ znul))) (entmake (list '(0 . "POINT") (cons 8 plnw1) (cons 10 pt) '(210 0.0 0.0 1.0) '(50 . 0.0) ) ) (cond ((= alt_ok "1") (if (/= (rtos alt 2 3) "0.000") (entmake (list '(0 . "TEXT") (cons 8 plnw3) (list '10 (car pt) (cadr pt) '0.0) (cons 40 htx) (cons 1 (strcat " " (rtos alt 2 2))) '(50 . 0.0) '(7 . "$SPEC-LSP") '(210 0.0 0.0 1.0) ) ) ) ) ) (cond ((and num (eq num_ok "1")) (entmake (list '(0 . "TEXT") (cons 8 plnw2) (list '10 (car pt) (cadr pt) '0.0) (cons 40 htx) (cons 1 (strcat (itoa num) " ")) '(50 . 0.0) '(7 . "$SPEC-LSP") '(72 . 2) (list '11 (car pt) (cadr pt) '0.0) '(210 0.0 0.0 1.0) ) ) ) ) (princ "\t") (prin1 cnt) (princ " Point(s) dessine(s)\r") ) (progn (princ "Caracteres non reconnus !\r") (setq biz (1+ biz)) ) ) (setq a (read-line b)) (if (and a coma) (cv_str a drp_pt)) ) (if (/= znul 0) (progn (print znul) (princ "Point(s) d'altitude nulle")) ) (if (/= biz 0) (progn (print biz) (princ "Ligne(s) ont des caracteres non reconnus")) ) (princ "\nDessin du semis termine !") (setq tstval nil colorname nil toperr nil layedit_act nil getindex nil espa nil laylist_act nil tststr nil test-ok nil reset-lay nil v_chg nil cv_str nil getlayer nil makelaylists nil c:topo nil ) ) (T (princ "\n*Arrêt*")) ) ) ) (T (princ "\n*Arrêt*")) ) ) (unload_dialog dcl_id) (close b) )(T (princ "\n*Arrêt*")) ) (setvar "textstyle" sv_sty) (setq *error* olderr) (setvar "cmdecho" sv_cmd) ) (T (princ "\nVous êtes dans l'Espace Papier, commande TOPO interdite") (princ "\nChoisissez l'Espace Objet") ) ) (prin1) ) voici sont dcl topo.dcl topo_id : dialog { label = "Extraction du fichier de points"; : paragraph { :text_part { label = "Extrait de la 1ère ligne du fichier: "; } :boxed_row { :text_part { key = "demons"; width = 70; is_bold = true; } } :text_part { label = ""; } :text_part { label = "Le fichiers de points ASCII peut être de la forme :"; } :text_part { label = "\t | Numero | X du point | Y du point | Z du point | code |"; } :text_part { label = "\t | Numero | X du point | Y du point | Z du point | |"; } :text_part { label = "\tou | X du point | Y du point | Z du point | code | |"; } :text_part { label = "\tou | X du point | Y du point | Z du point | | |"; } :text_part { label = "\tou | X du point | Y du point | | | |"; } :text_part { label = ""; } } : radio_row { label = "Options si virgule présente dans le fichier de points"; :radio_button { label = "Virgule = point décimal"; mnemonic = "d"; key = "coma_pt"; } :radio_button { label = "Virgule = séparateur"; mnemonic = "s"; key = "coma_sp"; } } ok_cancel_err; } topo : dialog { label = "Définition du semis de point"; :row { :column { :boxed_column { label = "Choix de l'échelle"; :list_box { multiple_select=false; key="lst_ech"; width=10; } :edit_box { label = "Echelle:"; mnemonic = "E"; key = "c_ech"; width = 6; edit_width = 6; } } } :column { :button { label = "Forme des points..."; mnemonic = "F"; key = "mod_pt"; fixed_width = true; alignment = centered; } :boxed_column { label = "Choix du plan pour le Semis"; :edit_box { label = "Plan:"; mnemonic = "P"; key = "pl_sem"; width = 32; edit_width = 32; edit_limit = 31; } : button { label = "Dialogue des plans..."; mnemonic = "D"; key = "pln_sem"; fixed_width = true; alignment = right; } } :boxed_column { label = "Choix du plan pour les Altitudes"; :edit_box { label = "Plan:"; mnemonic = "P"; key = "pl_alt"; width = 32; edit_width = 32; edit_limit = 31; } : row { : toggle { label = "Altitude"; mnemonic = "A"; key = "k_alt"; } : button { label = "Dialogue des plans..."; mnemonic = "D"; key = "pln_alt"; fixed_width = true; alignment = centered; } } } :boxed_column { label = "Choix du plan pour les Numéros"; :edit_box { label = "Plan:"; mnemonic = "P"; key = "pl_num"; width = 32; edit_width = 32; edit_limit = 31; } : row { : toggle { label = "Numéro"; mnemonic = "N"; key = "k_num"; } : button { label = "Dialogue des plans..."; mnemonic = "D"; key = "pln_num"; fixed_width = true; alignment = centered; } } } } } :row { ok_cancel_err; } } setlayer : dialog { subassembly = 0; label = "Choix du Plan"; initial_focus = "listbox"; : concatenation { children_fixed_width = true; key = "clayer"; : text_part { label = "Plan Courant: "; } : text_part { key = "cur_layer"; width = 35; } } : row { fixed_width = true; key = "titles"; children_fixed_width = true; : text { label = "Nom du Plan"; width = 34; } : text { label = "Etat"; width = 9; } : text { label = "Couleur"; width = 8; } : text { label = "Type de ligne"; width = 12; } } : list_box { tabs = "32 35 37 39 41 44 53"; width = 67; height = 12; key = "list_lay"; allow_accept = true; } : row { key = "controls"; : column { key = "lname"; fixed_width = true; : edit_box { label = "Définir le Nom du Plan:"; mnemonic = "D"; key = "edit_lay"; width = 32; edit_width = 32; edit_limit = 31; allow_accept = true; } } } ok_cancel_err; }