harshad Posted October 29, 2007 Posted October 29, 2007 HI ALL WANT LISP FOR INPUT DATA IN CAD i have a ground level sample x y z 17 20 2.5 21 24 3.4 25 28 4.3 29 32 5.2 33 36 2.5 37 40 3.4 of plot i have x,y & z corrdinate i havve to plot this in autocad but plotting z valu shown on display point and text is one block after that when i ckeck list of that it is on same x,y&z cordinate. please refer sample attached:) thanks harshad:) SAMPLE.pdf Quote
fixo Posted October 29, 2007 Posted October 29, 2007 Try this one ;; local defun ;; entmake block (defun makepoint () (if (not (tblsearch "BLOCK" "POINT_ELEV")) (progn (initget 6) (setq hgt (getreal "\n Enter text height of attribute <2.5>: ")) (if (not hgt) (setq hgt 2.5)) (entmake (mapcar 'cons (list 0 8 2 70 10 3) (list "BLOCK" "0" "POINT_ELEV" 2 '(0 0 0) "POINT_ELEV"))) (entmake (mapcar 'cons (list 0 8 62 10 210 50) (list "POINT" "0" 0 (list 0 0 0) '(0 0 1) 0.0))) (entmake (mapcar 'cons (list 0 8 62 10 40 70 1 210 3 2) (list "ATTDEF" "0" 0 (list (/ hgt 2) (* hgt 2.5) 0) 2.5 9 "x" '(0 0 1) "Topo point X coordinate" "XCOORD"))) (entmake (mapcar 'cons (list 0 8 62 10 40 70 1 210 3 2) (list "ATTDEF" "0" 0 (list (/ hgt 2) (* hgt 1.5) 0) 2.5 9 "y" '(0 0 1) "Topo point Y coordinate" "YCOORD"))) (entmake (mapcar 'cons (list 0 8 62 10 40 70 1 210 3 2) (list "ATTDEF" "0" 6 (list (/ hgt 2) (/ hgt 2) 0) 2.5 8 "z" '(0 0 1) "Topo point Z coordinate" "ZCOORD"))) (entmake (mapcar 'cons (list 0 (list "ENDBLK" "0")))))) ;; main programm (defun C:PP (/ att_tag ent new_value next next_data osm point_list) (makepoint) (if (not (tblsearch "BLOCK" "POINT_ELEV")) (progn (alert "Something wrong\nprogramm stopped") (exit) (princ))) (setq osm (getvar "osmode")) (setvar "cmdecho" 0) (setvar "osmode" 0) (setq point_list (list '(17 20 2.5) '(21 24 3.4) '(25 28 4.3) '(29 32 5.2) '(33 36 2.5) '(37 40 3.4))) (foreach point point_list (command "._-insert" "POINT_ELEV" point 1 1 0) (setq ent (entlast)) (setq next ent) (while (setq next (entnext next)) (setq next_data (entget next)) (setq att_tag (cdr (assoc 2 next_data))) (cond ((eq (strcase "XCOORD") att_tag) (setq new_value (rtos (car point) 2 1))) ((eq (strcase "YCOORD") att_tag) (setq new_value (rtos (cadr point) 2 1))) ((eq (strcase "ZCOORD") att_tag) (setq new_value (rtos (caddr point) 2 1)))) (entmod (subst (cons 1 new_value) (assoc 1 next_data) next_data)) (entupd ent) ) ) (command "._zoom" "_e");by suit (setvar "osmode" osm) (setvar "cmdecho" 1) (princ) ) ;; TesT : (C:PP) (prompt "\n====================================\n") (prompt "\n\t>>>\tType PP to execute ... \t>>>\n") (prompt "\n====================================\n") (prin1) ~'J'~ Quote
harshad Posted October 31, 2007 Author Posted October 31, 2007 thanks fatty but i have lots of ground levels witch i send u is a sample i have more than 10,000 x,y,z cordinate let"s try u r best thanks harshad Quote
Guest Alan Cullen Posted October 31, 2007 Posted October 31, 2007 Do you have a file of the XYZ coords, and is the file "space" delimited? Quote
harshad Posted October 31, 2007 Author Posted October 31, 2007 i hope u know about the ground improvements from site i got x,y,z data i want to import it into the cad but z valu i want in display thats all our douctment is Confidential if any idia about to makeing script or lisp of that x,y,z points and done this input in one time thanks for reply harshad Quote
harshad Posted October 31, 2007 Author Posted October 31, 2007 See This Sample Cordinate .exel File Thanks Harshad SAMPLE.zip Quote
Guest Alan Cullen Posted October 31, 2007 Posted October 31, 2007 you got me, I've never used excell files before. But there are many threads here about it. Do a search and find the answer. Quote
fixo Posted October 31, 2007 Posted October 31, 2007 See This Sample Cordinate .exel File Thanks Harshad Keep watching this thread ~'J'~ Quote
fixo Posted October 31, 2007 Posted October 31, 2007 See how it will work for you ;; PP.lsp ;; read Excel, draw points in Acad as blocks with attributes ;; local defun ;; entmake block (defun makepoint () (if (not (tblsearch "BLOCK" "POINT_ELEV")) (progn (initget 6) (setq hgt (getreal "\n Enter text height of attribute <2.5>: ")) (if (not hgt) (setq hgt 2.5)) (entmake (mapcar 'cons (list 0 8 2 70 10 3) (list "BLOCK" "0" "POINT_ELEV" 2 '(0 0 0) "POINT_ELEV"))) (entmake (mapcar 'cons (list 0 8 62 10 210 50) (list "POINT" "0" 0 (list 0 0 0) '(0 0 1) 0.0))) (entmake (mapcar 'cons (list 0 8 62 10 40 70 1 210 3 2) (list "ATTDEF" "0" 0 (list (/ hgt 2) (* hgt 2.5) 0) 2.5 9 "x" '(0 0 1) "Topo point X coordinate" "XCOORD"))) (entmake (mapcar 'cons (list 0 8 62 10 40 70 1 210 3 2) (list "ATTDEF" "0" 0 (list (/ hgt 2) (* hgt 1.5) 0) 2.5 9 "y" '(0 0 1) "Topo point Y coordinate" "YCOORD"))) (entmake (mapcar 'cons (list 0 8 62 10 40 70 1 210 3 2) (list "ATTDEF" "0" 6 (list (/ hgt 2) (/ hgt 2) 0) 2.5 8 "z" '(0 0 1) "Topo point Z coordinate" "ZCOORD"))) (entmake (mapcar 'cons (list 0 (list "ENDBLK" "0")))))) ;; local defun ;; to read the Excel range (defun EXR (FilePath ShtNum StrRange / ExcelApp ExcData Sht UsdRange Wbk) ;; based on function "EXD" from this page: ;; http://www.cadforyou.spb.ru/index.php?current_section=section_functions_page (vl-load-com) (setq ExcelApp (vlax-get-or-create-object "Excel.Application")) (vla-put-visible ExcelApp :vlax-true) ; or :vlax-false if you want (vlax-put-property ExcelApp 'DisplayAlerts :vlax-false) (setq Wbk (vl-catch-all-apply 'vla-open (list (vlax-get-property ExcelApp "WorkBooks") FilePath) ) ) (setq Sht (vl-catch-all-apply 'vlax-get-property (list (vlax-get-property Wbk "Sheets") "Item" ShtNum ) ) ) (vlax-invoke-method Sht "Activate") (setq UsdRange (vlax-get-property (vlax-get-property Sht 'Cells) "Range" StrRange) ExcData (vlax-safearray->list (vlax-variant-value (vlax-get-property UsdRange 'Value2) ) ) ) (setq ExcData (mapcar (function (lambda (x) (mapcar 'vlax-variant-value x))) ExcData ) ) (vl-catch-all-apply 'vlax-invoke-method (list Wbk "Close") ) (vl-catch-all-apply 'vlax-invoke-method (list ExcelApp "Quit") ) (mapcar (function (lambda (x) (vl-catch-all-apply (function (lambda () (progn (if (not (vlax-object-released-p x)) (progn (vlax-release-object x) (setq x nil) ) ) ) ) ) ) ) ) (list UsdRange Sht Wbk ExcelApp) ) (gc) (gc) ExcData ) ;; main part ;; (defun C:PP (/ Att_Tag Ent Filepath Headflag New_Value Next Next_Data Osm Poinlist Response Shtnum Strrange) (or (vl-load-com)) (setq FilePath (getfiled "Select Excel file to read :" (getvar "dwgprefix") "xls" 16 ) ) (initget 6) (setq ShtNum (getint "\nEnter the sheet number <1> : ")) (if (not ShtNum) (setq ShtNum 1)) (setq strRange (strcase (getstring "\n Enter address of used range <A1:C99>: "))) (if (eq "" strRange) (setq strRange "A1:C99")) (initget "Yes No") (setq Response (getkword "\n Is the Excel table has the headers? (Y/N) <Y>: ")) (if (not Response) (setq Response "Yes")) (if (eq "Yes" Response) (setq HeadFlag T) (setq HeadFlag nil)) (setq PoinList (EXR FilePath ShtNum strRange)) (if HeadFlag (setq PoinList (cdr PoinList))) (if PoinList (progn (makepoint) (if (not (tblsearch "BLOCK" "POINT_ELEV")) (progn (alert "Something wrong\nprogramm stopped") (exit) (princ))) (setq osm (getvar "osmode")) (setvar "cmdecho" 0) (setvar "osmode" 0) (foreach point PoinList (command "._-insert" "POINT_ELEV" point 1 1 0) (setq ent (entlast)) (setq next ent) (while (setq next (entnext next)) (setq next_data (entget next)) (setq att_tag (cdr (assoc 2 next_data))) (cond ((eq (strcase "XCOORD") att_tag) (setq new_value (rtos (car point) 2 1))) ((eq (strcase "YCOORD") att_tag) (setq new_value (rtos (cadr point) 2 1))) ((eq (strcase "ZCOORD") att_tag) (setq new_value (rtos (caddr point) 2 1)))) (entmod (subst (cons 1 new_value) (assoc 1 next_data) next_data)) (entupd ent) ) ) (command "._zoom" "_e");by suit ) (alert "Trouble with reading Excel data") ) (setvar "osmode" osm) (setvar "cmdecho" 1) (princ) ) ;; TesT : (C:PP) (prompt "\n====================================\n") (prompt "\n\t>>>\tType PP to execute ... \t>>>\n") (prompt "\n====================================\n") (prin1) ~'J'~ Quote
harshad Posted October 31, 2007 Author Posted October 31, 2007 ok fatty try u r best best of luck! thanks harshad Quote
harshad Posted October 31, 2007 Author Posted October 31, 2007 See how it will work for you ;; PP.lsp ;; read Excel, draw points in Acad as blocks with attributes ;; local defun ;; entmake block (defun makepoint () (if (not (tblsearch "BLOCK" "POINT_ELEV")) (progn (initget 6) (setq hgt (getreal "\n Enter text height of attribute <2.5>: ")) (if (not hgt) (setq hgt 2.5)) (entmake (mapcar 'cons (list 0 8 2 70 10 3) (list "BLOCK" "0" "POINT_ELEV" 2 '(0 0 0) "POINT_ELEV"))) (entmake (mapcar 'cons (list 0 8 62 10 210 50) (list "POINT" "0" 0 (list 0 0 0) '(0 0 1) 0.0))) (entmake (mapcar 'cons (list 0 8 62 10 40 70 1 210 3 2) (list "ATTDEF" "0" 0 (list (/ hgt 2) (* hgt 2.5) 0) 2.5 9 "x" '(0 0 1) "Topo point X coordinate" "XCOORD"))) (entmake (mapcar 'cons (list 0 8 62 10 40 70 1 210 3 2) (list "ATTDEF" "0" 0 (list (/ hgt 2) (* hgt 1.5) 0) 2.5 9 "y" '(0 0 1) "Topo point Y coordinate" "YCOORD"))) (entmake (mapcar 'cons (list 0 8 62 10 40 70 1 210 3 2) (list "ATTDEF" "0" 6 (list (/ hgt 2) (/ hgt 2) 0) 2.5 8 "z" '(0 0 1) "Topo point Z coordinate" "ZCOORD"))) (entmake (mapcar 'cons (list 0 (list "ENDBLK" "0")))))) ;; local defun ;; to read the Excel range (defun EXR (FilePath ShtNum StrRange / ExcelApp ExcData Sht UsdRange Wbk) ;; based on function "EXD" from this page: ;; http://www.cadforyou.spb.ru/index.php?current_section=section_functions_page (vl-load-com) (setq ExcelApp (vlax-get-or-create-object "Excel.Application")) (vla-put-visible ExcelApp :vlax-true) ; or :vlax-false if you want (vlax-put-property ExcelApp 'DisplayAlerts :vlax-false) (setq Wbk (vl-catch-all-apply 'vla-open (list (vlax-get-property ExcelApp "WorkBooks") FilePath) ) ) (setq Sht (vl-catch-all-apply 'vlax-get-property (list (vlax-get-property Wbk "Sheets") "Item" ShtNum ) ) ) (vlax-invoke-method Sht "Activate") (setq UsdRange (vlax-get-property (vlax-get-property Sht 'Cells) "Range" StrRange) ExcData (vlax-safearray->list (vlax-variant-value (vlax-get-property UsdRange 'Value2) ) ) ) (setq ExcData (mapcar (function (lambda (x) (mapcar 'vlax-variant-value x))) ExcData ) ) (vl-catch-all-apply 'vlax-invoke-method (list Wbk "Close") ) (vl-catch-all-apply 'vlax-invoke-method (list ExcelApp "Quit") ) (mapcar (function (lambda (x) (vl-catch-all-apply (function (lambda () (progn (if (not (vlax-object-released-p x)) (progn (vlax-release-object x) (setq x nil) ) ) ) ) ) ) ) ) (list UsdRange Sht Wbk ExcelApp) ) (gc) (gc) ExcData ) ;; main part ;; (defun C:PP (/ Att_Tag Ent Filepath Headflag New_Value Next Next_Data Osm Poinlist Response Shtnum Strrange) (or (vl-load-com)) (setq FilePath (getfiled "Select Excel file to read :" (getvar "dwgprefix") "xls" 16 ) ) (initget 6) (setq ShtNum (getint "\nEnter the sheet number <1> : ")) (if (not ShtNum) (setq ShtNum 1)) (setq strRange (strcase (getstring "\n Enter address of used range <A1:C99>: "))) (if (eq "" strRange) (setq strRange "A1:C99")) (initget "Yes No") (setq Response (getkword "\n Is the Excel table has the headers? (Y/N) <Y>: ")) (if (not Response) (setq Response "Yes")) (if (eq "Yes" Response) (setq HeadFlag T) (setq HeadFlag nil)) (setq PoinList (EXR FilePath ShtNum strRange)) (if HeadFlag (setq PoinList (cdr PoinList))) (if PoinList (progn (makepoint) (if (not (tblsearch "BLOCK" "POINT_ELEV")) (progn (alert "Something wrong\nprogramm stopped") (exit) (princ))) (setq osm (getvar "osmode")) (setvar "cmdecho" 0) (setvar "osmode" 0) (foreach point PoinList (command "._-insert" "POINT_ELEV" point 1 1 0) (setq ent (entlast)) (setq next ent) (while (setq next (entnext next)) (setq next_data (entget next)) (setq att_tag (cdr (assoc 2 next_data))) (cond ((eq (strcase "XCOORD") att_tag) (setq new_value (rtos (car point) 2 1))) ((eq (strcase "YCOORD") att_tag) (setq new_value (rtos (cadr point) 2 1))) ((eq (strcase "ZCOORD") att_tag) (setq new_value (rtos (caddr point) 2 1)))) (entmod (subst (cons 1 new_value) (assoc 1 next_data) next_data)) (entupd ent) ) ) (command "._zoom" "_e");by suit ) (alert "Trouble with reading Excel data") ) (setvar "osmode" osm) (setvar "cmdecho" 1) (princ) ) ;; TesT : (C:PP) (prompt "\n====================================\n") (prompt "\n\t>>>\tType PP to execute ... \t>>>\n") (prompt "\n====================================\n") (prin1) ~'J'~ fatty u r done very good job but 1 probleam z valu takes one diget after point for that its take maxzimum 3 diget after point Quote
fixo Posted October 31, 2007 Posted October 31, 2007 Take a look at RTOS function in the Help file ~'J'~ Quote
Guest Alan Cullen Posted October 31, 2007 Posted October 31, 2007 Cheers, Fatty, Just trying to boost my post count here: rtos ......... Converts a number into a string (rtos number [mode [precision]]) mode = 2 (decimal) precision = ? Quote
fixo Posted October 31, 2007 Posted October 31, 2007 Alan, sorry for the late (rtos number [mode [precision]]) mode = 2 (decimal) precision = number of digits say to display 3 digits it should : (rtos SomeNumericVariable 2 3) Thanks ~'J'~ Quote
harshad Posted November 1, 2007 Author Posted November 1, 2007 thank u very much fatty u solve my problem once again thanks harshad:) :) Quote
oliver Posted March 22, 2009 Posted March 22, 2009 thank...very useful to my part.. cheers oliver ;; PP.lsp ;; read Excel, draw points in Acad as blocks with attributes ;; local defun ;; entmake block (defun makepoint () (if (not (tblsearch "BLOCK" "POINT_ELEV")) (progn (initget 6) (setq hgt (getreal "\n Enter text height of attribute : ")) (if (not hgt) (setq hgt 2.5)) (entmake (mapcar 'cons (list 0 8 2 70 10 3) (list "BLOCK" "0" "POINT_ELEV" 2 '(0 0 0) "POINT_ELEV"))) (entmake (mapcar 'cons (list 0 8 62 10 210 50) (list "POINT" "0" 0 (list 0 0 0) '(0 0 1) 0.0))) (entmake (mapcar 'cons (list 0 8 62 10 40 70 1 210 3 2) (list "ATTDEF" "0" 0 (list (/ hgt 2) (* hgt 2.5) 0) 2.5 9 "x" '(0 0 1) "Topo point X coordinate" "XCOORD"))) (entmake (mapcar 'cons (list 0 8 62 10 40 70 1 210 3 2) (list "ATTDEF" "0" 0 (list (/ hgt 2) (* hgt 1.5) 0) 2.5 9 "y" '(0 0 1) "Topo point Y coordinate" "YCOORD"))) (entmake (mapcar 'cons (list 0 8 62 10 40 70 1 210 3 2) (list "ATTDEF" "0" 6 (list (/ hgt 2) (/ hgt 2) 0) 2.5 8 "z" '(0 0 1) "Topo point Z coordinate" "ZCOORD"))) (entmake (mapcar 'cons (list 0 (list "ENDBLK" "0")))))) ;; local defun ;; to read the Excel range (defun EXR (FilePath ShtNum StrRange / ExcelApp ExcData Sht UsdRange Wbk) ;; based on function "EXD" from this page: ;; http://www.cadforyou.spb.ru/index.php?current_section=section_functions_page (vl-load-com) (setq ExcelApp (vlax-get-or-create-object "Excel.Application")) (vla-put-visible ExcelApp :vlax-true) ; or :vlax-false if you want (vlax-put-property ExcelApp 'DisplayAlerts :vlax-false) (setq Wbk (vl-catch-all-apply 'vla-open (list (vlax-get-property ExcelApp "WorkBooks") FilePath) ) ) (setq Sht (vl-catch-all-apply 'vlax-get-property (list (vlax-get-property Wbk "Sheets") "Item" ShtNum ) ) ) (vlax-invoke-method Sht "Activate") (setq UsdRange (vlax-get-property (vlax-get-property Sht 'Cells) "Range" StrRange) ExcData (vlax-safearray->list (vlax-variant-value (vlax-get-property UsdRange 'Value2) ) ) ) (setq ExcData (mapcar (function (lambda (x) (mapcar 'vlax-variant-value x))) ExcData ) ) (vl-catch-all-apply 'vlax-invoke-method (list Wbk "Close") ) (vl-catch-all-apply 'vlax-invoke-method (list ExcelApp "Quit") ) (mapcar (function (lambda (x) (vl-catch-all-apply (function (lambda () (progn (if (not (vlax-object-released-p x)) (progn (vlax-release-object x) (setq x nil) ) ) ) ) ) ) ) ) (list UsdRange Sht Wbk ExcelApp) ) (gc) (gc) ExcData ) ;; main part ;; (defun C:PP (/ Att_Tag Ent Filepath Headflag New_Value Next Next_Data Osm Poinlist Response Shtnum Strrange) (or (vl-load-com)) (setq FilePath (getfiled "Select Excel file to read :" (getvar "dwgprefix") "xls" 16 ) ) (initget 6) (setq ShtNum (getint "\nEnter the sheet number : ")) (if (not ShtNum) (setq ShtNum 1)) (setq strRange (strcase (getstring "\n Enter address of used range : "))) (if (eq "" strRange) (setq strRange "A1:C99")) (initget "Yes No") (setq Response (getkword "\n Is the Excel table has the headers? (Y/N) : ")) (if (not Response) (setq Response "Yes")) (if (eq "Yes" Response) (setq HeadFlag T) (setq HeadFlag nil)) (setq PoinList (EXR FilePath ShtNum strRange)) (if HeadFlag (setq PoinList (cdr PoinList))) (if PoinList (progn (makepoint) (if (not (tblsearch "BLOCK" "POINT_ELEV")) (progn (alert "Something wrong\nprogramm stopped") (exit) (princ))) (setq osm (getvar "osmode")) (setvar "cmdecho" 0) (setvar "osmode" 0) (foreach point PoinList (command "._-insert" "POINT_ELEV" point 1 1 0) (setq ent (entlast)) (setq next ent) (while (setq next (entnext next)) (setq next_data (entget next)) (setq att_tag (cdr (assoc 2 next_data))) (cond ((eq (strcase "XCOORD") att_tag) (setq new_value (rtos (car point) 2 1))) ((eq (strcase "YCOORD") att_tag) (setq new_value (rtos (cadr point) 2 1))) ((eq (strcase "ZCOORD") att_tag) (setq new_value (rtos (caddr point) 2 1)))) (entmod (subst (cons 1 new_value) (assoc 1 next_data) next_data)) (entupd ent) ) ) (command "._zoom" "_e");by suit ) (alert "Trouble with reading Excel data") ) (setvar "osmode" osm) (setvar "cmdecho" 1) (princ) ) ;; TesT : (C:PP) (prompt "\n====================================\n") (prompt "\n\t>>>\tType PP to execute ... \t>>>\n") (prompt "\n====================================\n") (prin1) any update instead of Z or elev..change into point labels or point numbering. Quote
Lee Mac Posted March 22, 2009 Posted March 22, 2009 Are you sure you're not looking for something like this thread? http://www.cadtutor.net/forum/showthread.php?t=34092 Quote
oliver Posted March 22, 2009 Posted March 22, 2009 no its not...seems as what he did of "fixo" for harshad export from excel. will i just found out another routine...try to found out what is this..but they are looking another files.. ;; Internal error handler defined locally ;; (defun al_err (s) ; If an error (such as CTRL-C) occurs ; while this command is active... (if (/= s "Function cancelled") (princ (strcat "\nError: " s)) ) (if al_oe ; If an old error routine exists (setq *error* al_oe) ; then, reset it ) (setq aliasi (close aliasi)) (setvar "cmdecho" al_oce) ; Reset command echoing on error (princ) ) ;; ;; Body of alias function ;; (if *error* ; Set our new error handler (setq al_oe *error* *error* al_err) (setq *error* al_err) ) (DEFUN C:TOPO () (COMMAND "LAYER" "N" "SIGN" "C" "1" "SIGN" "") (COMMAND "LAYER" "N" "LEVEL" "C" "7" "LEVEL" "") (COMMAND "LAYER" "N" "PNT_CEN" "C" "7" "PNT_CEN" "") (COMMAND "LAYER" "N" "PNT_NUM" "C" "2" "PNT_NUM" "") (initget (+ 1 2 4)) (setq raz (getreal "Imenitelj razmere .........: ")) (initget (+ 1 2 4)) (setq fnt (getreal "Visina ispisa [mm] .........: ")) (setq oang (getreal "Zakosenje ispisa [dec. step.] ...: ")) (setq fnt (* fnt (/ raz 1000))) ;(setq dia (* fnt 1.25)) (setq dia (* fnt 0.) ;(setq dia fnt) ############## TP ;(setq dis (/ fnt 5)) (setq dis (/ fnt 4)) (setq dpn (/ fnt 4)) (setq imefnt "1") (setq ffile "ROMANS") (setq wfac 0.75) (setq non "N") (COMMAND "PDMODE" "32") (COMMAND "PDSIZE" "0.125") (COMMAND "STYLE") (COMMAND imefnt) (COMMAND ffile) (COMMAND fnt) (COMMAND wfac) (COMMAND oang) (COMMAND non) (COMMAND non) (COMMAND non) (setvar "CMDECHO" 0) (setq f (getfiled "Fajla tacaka" "" "*" 4)) (setq fr (open f "r")) (setq k 0 Cr " " Row " ") (while (/= Row nil) (setq Row (read-line fr)) (if (/= Row nil) (progn (SPC) (if (> k 1) (TRIMS) ) (VALU) (setq Pn (substr Row 1 (- k 1))) (TRIMS) (SPC) (TRIMS) (VALU) (setq y (atof (substr Row 1 (- k 1)))) (TRIMS) (SPC) (TRIMS) (VALU) (setq x (atof (substr Row 1 (- k 1)))) (TRIMS) (if (= Cr " ") (progn (SPC) (TRIMS) ) ) (setq h nil s nil) (VALU) (if (> k 1) (progn (if (< (ascii (substr Row 1 1)) 58) (setq h (atof (substr Row 1 (- k 1)))) (setq h nil s (substr Row 1 (- k 1))) ) ) ) (TRIMS) (if (= Cr " ") (progn (SPC) (TRIMS) ) ) (if (and (= s nil) (/= (substr Row 1 1) "")) (progn (VALU) (setq s (substr Row 1 (- k 1))) ) ) (setq tc (list y x)) (WRT) (if (/= h nil) (WRTH) ) (if (/= s nil) (WRTS) ) ) (progn (COMMAND "LAYER" "S" "0" "") (COMMAND "ZOOM" "E" "") (prin1) ) ) ) (close fr) ; (close m) ) (DEFUN SPC () (setq k 0 Cr " ") (while (= Cr " ") (setq k (+ k 1)) (setq Cr (substr Row k 1)) ) ) (DEFUN VALU () (setq k 0 Cr "&") (while (and (/= Cr " ") (/= Cr "")) (setq k (+ k 1)) (setq Cr (substr Row k 1)) ) ) (DEFUN TRIMS () (setq tmp (substr Row k)) (setq Row tmp) ) (DEFUN WRT () (if (/= s nil) (progn (if (or (= (strcase s) "P") (= (strcase s) "T")) (setq tn (list y (+ x fnt))) (setq tn (list y (+ x dpn))) ) ) (setq tn (list y (+ x dpn))) ) (COMMAND "LAYER" "S" "PNT_CEN" "") (COMMAND "POINT" tc) (COMMAND "LAYER" "S" "PNT_NUM" "") (COMMAND "TEXT" "S" "1" "BC" tn "0" Pn) ) (DEFUN WRTH () (if (/= s nil) (progn (if (or (= (strcase s) "P") (= (strcase s) "T")) (setq tl (list (+ y fnt) x)) (setq tl (list (+ y dis) x)) ) ) (setq tl (list (+ y dis) x)) ) (setq hs (rtos h 2 2)) (setq l (strlen hs)) (setq hs (substr hs 1 l)) (DEC) (setq p (- l k)) ; (cond ((= k l) (setq hs (strcat hs ".00"))) ; ((= (- l 1)) (setq hs (strcat hs "0"))) ; (progn (cond ((= p 0) (setq hs (strcat hs ".00"))) ((= p 1) (setq hs (strcat hs "0"))) ) ; ) (COMMAND "LAYER" "S" "LEVEL" "") (COMMAND "TEXT" "S" "1" "TL" tl "0" hs) ) (DEFUN WRTS () (setq ts (list (- y (/ fnt 1.625)) x)) ; (setq ts (list (- y dis) x)) (COMMAND "LAYER" "S" "SIGN" "") (if (= (strcase s) "T" ) (TRG) ) (if (= (strcase s) "P" ) (TRP) ) (if (and (/= (strcase s) "P") (/= (strcase s) "T")) (COMMAND "TEXT" "S" "1" "MR" ts "0" s) ) ) (DEFUN DEC () (setq k 0 Cr "&" l (strlen hs)) (while (and (< k l) (/= Cr ".")) (setq k (+ k 1)) (setq Cr (substr hs k 1)) ) ) (DEFUN TRG () ; (setq a (/ (sqrt (/ (expt dia 2) 3)) 2)) (setq a (sqrt (/ (expt dia 2) 3))) (setq b (* a (/ (sin 0.5236) (cos 0.5236)))) ; (setq b (* a (/ (sin 30) (cos 30)))) ; (setq b (* a (/ 1 (atan 0.5236)))) (setq c (- dia b)) (setq t1 (list (+ y a) (- x b))) (setq t2 (list (- y a) (- x b))) (setq t3 (list y (+ x c))) (COMMAND "LINE" t1 t2 t3 t1 "") ) (DEFUN TRP () (COMMAND "LAYER" "S" "SIGN" "") (COMMAND "CIRCLE" tc (/ dia 2)) ) (princ "..!") (prompt "\rProgram se startuje sa TOPO\007") (prin1) Quote
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.