CAD programy 4M
Import bodů z textového souboru
Aplikace pro import bodů z geodetického zaměření do CAD programů. Je načten soubor umístěný na adrese C:/temp/pnt.txt. Formát zdrojového souboru je ve sloupcích oddělených jednou nebo více mezerami: id bodu a souřadnice X, Y, Z. Další údaje na řádku nejsou zpracovány.Aplikace vytvoří ve výkrese nové hladiny a v daných souřadnicích bodové entity. Souřadnice X a Y jsou převedeny na záporné hodnoty. Body jsou označeny výškou a jejich ID.
Vzorový soubor s daty
(defun C:pnt() (if (= (tblsearch "LAYER" "bod-oznac") nil) (progn (command "_layer" "n" "bod-oznac" "")(command)) ) (if (= (tblsearch "LAYER" "bod-vyska") nil) (progn (command "_layer" "n" "bod-vyska" "")(command)) ) (if (= (tblsearch "LAYER" "bod-cislo") nil) (progn (command "_layer" "n" "bod-cislo" "")(command)) ) (setq fil (open "C:/temp/pnt.txt" "r")) ;(setvar "regenmode" 0) ;(setq maxdisplacement 0) (while (setq rline (read-line fil)) ; shortens line in case it starts with empty space ;(if (= (substr rline 1 1) " ") (setq rline (substr rline 2 (strlen rline)))) (setq strct 1) (setq id_all 0) (setq pntx_all 0) (setq pnty_all 0) (setq pntz_all 0) (setq dot 0) (setq code_all 0) (setq rline2 "") (setq id "") (setq pntx "") (setq pnty "") (setq pntz "") (setq pnt1 "") (setq pnt2 "") (setq code "") ;(setq tmplist (list)) ; puts list of double spaces in line into tmplist (repeat (strlen rline) (setq letter (substr rline strct 1)) (setq letter2 (substr rline (+ strct 1) 1)) (if (= letter " ") (progn (setq strct (1+ strct)) ) (progn (cond ((= id_all 0) (setq id (strcat id letter)) (if (= letter2 " ") (setq id_all 1)) ) ((and (= id_all 1) (= pntx_all 0)) (setq pntx (strcat pntx letter)) (if (= letter2 " ") (setq pntx_all 1)) ) ((and (= pntx_all 1) (= pnty_all 0)) (setq pnty (strcat pnty letter)) (if (= letter2 " ") (setq pnty_all 1)) ) ((and (= pnty_all 1) (= pntz_all 0)) (setq pntz (strcat pntz letter)) (if (/= letter ".") (if (= dot 0) (progn (setq pnt1 (strcat pnt1 letter)) (if (= letter2 ".") (setq dot 1)) ) (progn (setq pnt2 (strcat pnt2 letter)) ) )) (if (= letter2 " ") (setq pntz_all 1)) ) ((and (= pntz_all 1) (= code_all 0)) (setq code (strcat code letter)) (if (= letter2 " ") (setq code_all 1)) ) ) (setq strct (1+ strct)) ) ) ) ;(princ "\n") ;(princ (strcat id " " pntx " " pnty " " pntz " " code)) ;(princ (strcat pnt1 " " pnt2)) (if (= (strlen pnt2) 2) (setq pnt2 (strcat pnt2 "0"))) (setq height (strcat pnt1 " " pnt2)) ;(setq pntx_num (* -1 (atof pntx))) (setq pntx_num (atof pntx)) ;(setq pnty_num (* -1 (atof pnty))) (setq pnty_num (atof pnty)) (setq pntz_num (atof pntz)) (setq pt (list pntx_num pnty_num pntz_num)) (entmake (list '(0 . "POINT") '(8 . "bod-oznac") (cons 10 pt))) (entmake (list (cons 0 "TEXT") (cons 8 "bod-vyska") (cons 10 pt) (cons 11 pt) (cons 40 0.3) (cons 41 1) (cons 1 height) (cons 50 0) (cons 71 1) (cons 72 1) (cons 73 0) ) ) (entmake (list (cons 0 "TEXT") (cons 8 "bod-cislo") (cons 10 pt) (cons 11 pt) (cons 40 0.3) (cons 41 1) (cons 1 (strcat "\n" id)) (cons 50 0) (cons 71 1) (cons 72 1) (cons 73 0) ) ) (princ) ) )
Soubor ke stažení