BONUS CAD TOPO

[RhymOne]

Bonjour je suis à la recherche d'un lisp qui me chargerais un semis de point à partir d'un fichier .txt ou .xyz.

J'ai trouvé dans bonuscad le lisp TOPO;Mais à parement impossible de le faire fonctionné normalement.

Si il est possible de jeter un coup d'oeil....

Voila le lisp:

 

(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) ",") (

(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:topo2 ( / 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" "N" "N" "N"

)

)

)

(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))

(prompt "\rNom 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 (

(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 (

(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))

(prompt "\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)

) )

)

)

(prompt "\t") (prin1 cnt) (prompt " Point(s) dessine(s)\r")

)

(progn

(prompt "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) (prompt "\e[33mPoint(s) d'altitude nulle\e[0m"))

)

(if (/= biz 0)

(progn (print biz) (prompt "Ligne(s) ont des caracteres non reconnus"))

)

(prompt "\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 (prompt "\n*Arrêt*"))

)

)

)

(T (prompt "\n*Arrêt*"))

)

)

(unload_dialog dcl_id)

(close b)

)(T (prompt "\n*Arrêt*"))

)

(setvar "textstyle" sv_sty)

(setq *error* olderr)

(setvar "cmdecho" sv_cmd)

)

(T

(prompt "\nVous êtes dans l'Espace Papier, commande TOPO2 interdite")

(prompt "\nChoisissez l'Espace Objet")

)

)

(prin1)

)

 

[capde06]

cherche CAPTOPO sur google

[RhymOne]

Bonjour d'abord j'ai cherché mais c'est un applicatifs deja tout fait sa??,

Et a part des sites en anglais il y a pas grand choses pour cadtopo

[RhymOne]

Bon sayer j'ai trouvé merci bien.

Le site est http://sites.google.com/site/captopo/Home

Attendre de voir si sa marche bien...

[RhymOne]

OH NON

Les blocs sont insérés à l’altitude 0.00 dans le SCG et horizontal au SCU

C'est facheux pour faire un MNT après...

[bonuscad]

Bonjour,

 

(defun c:topo2 ( / sv_cmd sv_sty a b ech plnw1 plnw2 plnw3 num_ok alt_ok drp_pt

.....

(prompt "\nVous êtes dans l'Espace Papier, commande TOPO2 interdite")

 

Sur ma page perso le code original n'est pas défini sous cette forme.

 

Recharger l'original?

 

Tu peux essayer aussi celui de (gile) , tu auras peut être les options correspondant à ton type de fichier.

[capde06]

regarde bien, dans la boite de dialogue il y a option insérer en 3d