Nhờ chỉnh sửa

by ro88 Thu Jan 10, 2013 12:15 am

Code:: ;---------------------------------------------------------------------------- ;;; COMMAND: RD ;;; This command read datafile & draw line with elevation ;;; Datafile structure : North East Height ;---------------------------------------------------------------------------- (if (not ai_utils)(load "ai_utils")) (if (not my_utils)(load "my_utils")) ;---------------------------------------------------------------------------- (defun strltrim (s) (cond ((eq s "") s) ((or(= " " (substr s 1 1))(= " " (substr s 1 1))) s) (t (strltrim (substr s 2))) ) ) (defun tabltrim (s) (cond ((eq s "") s) ((or(= " " (substr s 1 1))(= " " (substr s 1 1))) (tabltrim (substr s 2))) (t s) ) ) ;---------------------------------------------------------------------------- ;; Subfunction for change 1 data-line to list (defun linetopoint(line) (setq y (read line) line (tabltrim line) line (strltrim line) x (read line) line (strltrim (tabltrim line)) z (read line) ) (setq point (list x y z)) ) ;;;----------------------------------------------- ;; Subfunction for read data from 1 file and change to list (defun read_fs() (setq dlist nil) (setq datafile (GETFILED "TUAN - Select data-file " (GETVAR "dwgprefix") "*" 2)) (setq filename datafile) (princ (strcat "\nPlease, wait!. READ & DRAW is reading data from " filename)) (if (setq f (open filename "r")) (progn (while (setq pl (read-line f)) (setq p (linetopoint pl) dlist (cons p dlist)) ) (close f) ) ) (reverse dlist) ) ;--------------------------------------------------- ;(defun C:van ( / li) ; (rd nil) ; (princ) ;) (defun c:van ( / li n i li htext) (setvar "cmdecho" 0) (setvar "blipmode" 0) (Setq ts (tblsearch "STYLE" (GETVAR "TEXTSTYLE"))) (setq tsize (cdr(assoc '40 ts))) (INITGET +3) (if (= tsize 0)(setq h (getreal "\nHeigth of text :"))(setq h tsize)) (initget) (setq tr (getreal "\nRotation of text <0>:")) (if (= tr nil) (setq tr 0)) ;------------------------------------------- (initget "y n Y N") (setq yn (getkword "\nDo you want to draw in 3D <y/n> ?<y>")) (if (= yn nil)(setq yn "Y")) (if (= (strcase yn) "N")(setq yn "N")(setq yn "Y")) ;------------------------------------------- ;(initget "y n Y N") ;(setq ynl (getkword "\nDo you want to connect each to other <y/n> ?<y>")) ;(if (= ynl nil)(setq ynl "Y")) ;(if (= (strcase ynl) "N")(setq ynl "N")(setq ynl "Y")) ;------------------------------------------- ;(initget "y n Y N") ;(setq ynd (getkword "\nDo you want to insert donut at each point <y/n> ?<y>")) ;(if (= ynd nil)(setq ynd "Y")) ;(if (= (strcase ynd) "N")(setq ynd "N")(setq ynd "Y")) ;------------------------------------------- ;(initget "y n Y N") ;(setq ynC (getkword "\nDo you want to insert coconut at each point <y/n> ?<y>")) ;(if (= ynC nil)(setq ynC "Y")) ;(if (= (strcase ynC) "N")(setq ynC "N")(setq ynC "Y")) ;------------------------------------------- ;(initget "y n Y N") ;(setq ynTD (getkword "\nDo you want to insert TD at each point <y/n> ?<y>")) ;(if (= ynTD nil)(setq ynTD "Y")) ;(if (= (strcase ynTD) "N")(setq ynTD "N")(setq ynTD "Y")) ;------------------------------------------- ;(initget "y n Y N") ;(setq ynCL (getkword "\nDo you want to insert CL at each point <y/n> ?<y>")) ;(if (= ynCL nil)(setq ynCL "Y")) ;(if (= (strcase ynCL) "N")(setq ynCL "N")(setq ynCL "Y")) ;------------------------------------------- (setq tb (* h 0.50)) (setq li (read_fs) n (length li) i -1 ipold (list 0 0 0)) ;(print li) (ai_undo_on) ; Turn UNDO on (command "_.UNDO" "_GROUP") (setq o_osmode (getvar "osmode")) (setvar "osmode" 0) ;(COMMAND "insert" "DONUT" "0,0") (command) (repeat n (setq i (1+ i) ip (nth i li) htext (zrtos (last ip) 2)) (setq ip1 (list (car ip) (cadr ip) 0.00)) (setq zi (atof htext)) (cond ((and( > zi 1000)(< zi 2000))(command "insert" "bienbao" ip1 tb tb 0)) ((and( > zi 2000)(< zi 3000))(command "insert" "buiram" ip1 tb tb 0)) ((and( > zi 3000)(< zi 4000))(command "insert" "cayanqua" ip1 tb tb 0)) ((and( > zi 4000)(< zi 5000))(command "insert" "caycothu" ip1 tb tb 0)) ((and( > zi 5000)(< zi 6000))(command "insert" "caydua" ip1 tb tb 0)) ((and( > zi 6000)(< zi 7000))(command "insert" "caylua" ip1 tb tb 0)) ((and( > zi 7000)(< zi 8000))(command "insert" "caymia" ip1 tb tb 0)) ((and( > zi 8000)(< zi 9000))(command "insert" "caynhon" ip1 tb tb 0)) ((and( > zi 9000)(< zi 10000))(command "insert" "caythong" ip1 tb tb 0)) ((and( > zi 10000)(< zi 11000))(command "insert" "caytre" ip1 tb tb 0)) ((and( > zi 11000)(< zi 12000))(command "insert" "cocchuyen" ip1 tb tb 0)) ((and( > zi 12000)(< zi 13000))(command "insert" "dadoclap" ip1 tb tb 0)) ((and( > zi 13000)(< zi 14000))(command "insert" "g1" ip1 tb tb 0)) ((and( > zi 14000)(< zi 15000))(command "insert" "g2" ip1 tb tb 0)) ((and( > zi 15000)(< zi 16000))(command "insert" "g3" ip1 tb tb 0)) ((and( > zi 16000)(< zi 17000))(command "insert" "g4" ip1 tb tb 0)) ((and( > zi 17000)(< zi 18000))(command "insert" "g5" ip1 tb tb 0)) ((and( > zi 18000)(< zi 19000))(command "insert" "gieng" ip1 tb tb 0)) ((and( > zi 19000)(< zi 20000))(command "insert" "hoamau" ip1 tb tb 0)) ((and( > zi 20000)(< zi 21000))(command "insert" "leduong" ip1 tb tb 0)) ((and( > zi 21000)(< zi 22000))(command "insert" "moma" ip1 tb tb 0)) ((and( > zi 22000)(< zi 23000))(command "insert" "rao" ip1 tb tb 0)) ((and( > zi 23000)(< zi 24000))(command "insert" "raumau" ip1 tb tb 0)) ((and( > zi 24000)(< zi 25000))(command "insert" "sl" ip1 tb tb 0)) ((and( > zi 25000)(< zi 26000))(command "insert" "t1" ip1 tb tb 0)) ((and( > zi 26000)(< zi 27000))(command "insert" "t2" ip1 tb tb 0)) ((and( > zi 27000)(< zi 28000))(command "insert" "t3" ip1 tb tb 0)) ((and( > zi 28000)(< zi 29000))(command "insert" "t4" ip1 tb tb 0)) ((and( > zi 29000)(< zi 30000))(command "insert" "tuong" ip1 tb tb 0)) ((and( > zi 30000)(< zi 31000))(command "insert" "tram" ip1 tb tb 0)) ((and( > zi 31000)(< zi 32000))(command "insert" "trucaothe" ip1 tb tb 0)) ((and( > zi 32000)(< zi 33000))(command "insert" "truco" ip1 tb tb 0)) ((and( > zi 33000)(< zi 34000))(command "insert" "truden" ip1 tb tb 0)) ((and( > zi 34000)(< zi 35000))(command "insert" "trudendoi" ip1 tb tb 0)) ((and( > zi 35000)(< zi 36000))(command "insert" "trudien1" ip1 tb tb 0)) ((and( > zi 36000)(< zi 37000))(command "insert" "truttin" ip1 tb tb 0)) ((and( > zi 37000)(< zi 38000))(command "insert" "2tuong" ip1 tb tb 0)) ((and( > zi 38000)(< zi 39000))(command "insert" "3tuong" ip1 tb tb 0)) ((and( > zi 39000)(< zi 40000))(command "insert" "2rao" ip1 tb tb 0)) ((and( > zi 40000)(< zi 41000))(command "insert" "3rao" ip1 tb tb 0)) ((and( > zi 41000)(< zi 42000))(command "insert" "T1T2" ip1 tb tb 0)) ((and( > zi 42000)(< zi 43000))(command "insert" "G1G2" ip1 tb tb 0)) ((and( > zi 43000)(< zi 44000))(command "insert" "Cong" ip1 tb tb 0)) ((and( > zi 44000)(< zi 45000))(command "insert" "Hangcay" ip1 tb tb 0)) ((and( > zi 45000)(< zi 46000))(command "insert" "Ao" ip1 tb tb 0)) ((and( > zi 46000)(< zi 47000))(command "insert" "Raokhac" ip1 tb tb 0)) ((and( > zi 47000)(< zi 48000))(command "insert" "trudien2" ip1 tb tb 0)) ((and( > zi 48000)(< zi 49000))(command "insert" "chanbc" ip1 tb tb 0)) ((and( > zi 49000)(< zi 50000))(command "insert" "tuongkhac" ip1 tb tb 0)) ((and( > zi 50000)(< zi 51000))(command "insert" "lekhac" ip1 tb tb 0)) ) ;(setq ip (list (car ip) (cadr ip) 0))) ;(if (= ynl "Y")(if (> i 1)(command "line" ipold ip ""))) ; (if (= ynd "Y")(command "insert" "donut" ip tb tb 0)) ;(if (= ynC "Y")(command "insert" "coconut" ip tb tb 0)) ;(if (= ynTD "Y")(command "insert" "TD" ip tb tb 0)) ;(if (= ynCL "Y")(command "insert" "CL" ip tb tb 0)) (cond ((< zi 1000)(setq ri (- (atof htext) 00.0))) ((and( > zi 1000)(< zi 2000))(setq ri (- (atof htext) 1000.0))) ((and( > zi 2000)(< zi 3000))(setq ri (- (atof htext) 2000.0))) ((and( > zi 3000)(< zi 4000))(setq ri (- (atof htext) 3000.0))) ((and( > zi 4000)(< zi 5000))(setq ri (- (atof htext) 4000.0))) ((and( > zi 5000)(< zi 6000))(setq ri (- (atof htext) 5000.0))) ((and( > zi 6000)(< zi 7000))(setq ri (- (atof htext) 6000.0))) ((and( > zi 7000)(< zi 8000))(setq ri (- (atof htext) 7000.0))) ((and( > zi 8000)(< zi 9000))(setq ri (- (atof htext) 8000.0))) ((and( > zi 9000)(< zi 10000))(setq ri (- (atof htext) 9000.0))) ((and( > zi 10000)(< zi 11000))(setq ri (- (atof htext) 10000.0))) ((and( > zi 11000)(< zi 12000))(setq ri (- (atof htext) 11000.0))) ((and( > zi 12000)(< zi 13000))(setq ri (- (atof htext) 12000.0))) ((and( > zi 13000)(< zi 14000))(setq ri (- (atof htext) 13000.0))) ((and( > zi 14000)(< zi 15000))(setq ri (- (atof htext) 14000.0))) ((and( > zi 15000)(< zi 16000))(setq ri (- (atof htext) 15000.0))) ((and( > zi 16000)(< zi 17000))(setq ri (- (atof htext) 16000.0))) ((and( > zi 17000)(< zi 18000))(setq ri (- (atof htext) 17000.0))) ((and( > zi 18000)(< zi 19000))(setq ri (- (atof htext) 18000.0))) ((and( > zi 19000)(< zi 20000))(setq ri (- (atof htext) 19000.0))) ((and( > zi 20000)(< zi 21000))(setq ri (- (atof htext) 20000.0))) ((and( > zi 21000)(< zi 22000))(setq ri (- (atof htext) 21000.0))) ((and( > zi 22000)(< zi 23000))(setq ri (- (atof htext) 22000.0))) ((and( > zi 23000)(< zi 24000))(setq ri (- (atof htext) 23000.0))) ((and( > zi 24000)(< zi 25000))(setq ri (- (atof htext) 24000.0))) ((and( > zi 25000)(< zi 26000))(setq ri (- (atof htext) 25000.0))) ((and( > zi 26000)(< zi 27000))(setq ri (- (atof htext) 26000.0))) ((and( > zi 27000)(< zi 28000))(setq ri (- (atof htext) 27000.0))) ((and( > zi 28000)(< zi 29000))(setq ri (- (atof htext) 28000.0))) ((and( > zi 29000)(< zi 30000))(setq ri (- (atof htext) 29000.0))) ((and( > zi 30000)(< zi 31000))(setq ri (- (atof htext) 30000.0))) ((and( > zi 31000)(< zi 32000))(setq ri (- (atof htext) 31000.0))) ((and( > zi 32000)(< zi 33000))(setq ri (- (atof htext) 32000.0))) ((and( > zi 33000)(< zi 34000))(setq ri (- (atof htext) 33000.0))) ((and( > zi 34000)(< zi 35000))(setq ri (- (atof htext) 34000.0))) ((and( > zi 35000)(< zi 36000))(setq ri (- (atof htext) 35000.0))) ((and( > zi 36000)(< zi 37000))(setq ri (- (atof htext) 36000.0))) ((and( > zi 37000)(< zi 38000))(setq ri (- (atof htext) 37000.0))) ((and( > zi 38000)(< zi 39000))(setq ri (- (atof htext) 38000.0))) ((and( > zi 39000)(< zi 40000))(setq ri (- (atof htext) 39000.0))) ((and( > zi 40000)(< zi 41000))(setq ri (- (atof htext) 40000.0))) ((and( > zi 41000)(< zi 42000))(setq ri (- (atof htext) 41000.0))) ((and( > zi 42000)(< zi 43000))(setq ri (- (atof htext) 42000.0))) ((and( > zi 43000)(< zi 44000))(setq ri (- (atof htext) 43000.0))) ((and( > zi 44000)(< zi 45000))(setq ri (- (atof htext) 44000.0))) ((and( > zi 45000)(< zi 46000))(setq ri (- (atof htext) 45000.0))) ((and( > zi 46000)(< zi 47000))(setq ri (- (atof htext) 46000.0))) ((and( > zi 47000)(< zi 48000))(setq ri (- (atof htext) 47000.0))) ((and( > zi 48000)(< zi 49000))(setq ri (- (atof htext) 48000.0))) ((and( > zi 49000)(< zi 50000))(setq ri (- (atof htext) 49000.0))) ((and( > zi 50000)(< zi 51000))(setq ri (- (atof htext) 50000.0))) ) (if (> (atof htext) 1000)(setq htext (zrtos ri 2))) (if (= yn "N")(setq ip (list (car ip) (cadr ip) 0.00))(setq ip (list (car ip) (cadr ip) ri))) (print ip) (if (= tsize 0) (COMMAND "text" "j" "c" ip h tr htext) (COMMAND "text" "j" "c" ip tr htext) ) (command "insert" "donut" ip tb tb 0) ;(neu su dung YN donut thi xoa ca hang nay) ;(setq ipold ip) ) (setvar "osmode" o_osmode) (command "_.UNDO" "_E") (ai_undo_off) (princ "\nThank you for using this command") (princ) ) ;;;-------------------------------------------------------------------------------- (princ " READ & DRAW loaded.") (princ )

Mình có lisp phun điểm này nhờ các Anh/Chị,sửa dùm với.
Lisp chạy tốt nhưng bị hạn chế là chỉ chạy được tới 99,xxx. Chỉ được 2 số nguyên tới 100,xxx là ko hiểu
Nhờ các Anh/ Chị sửa dùm
Lệnh: RD
chiều cao text:
Góc quay(0):
Do you want to draw in 3D (y/n)?
Thêm dòng này: Số thập phân :

copy lisp vào support của Cad và phải có dấu chấm vàng trong bản vẽ bên dưới thì lisp mới chạy được
Dưới đây là file TxT và file mẫu do lisp chạy được
[You must be registered and logged in to see this link.]

Mon	Tue	Wed	Thu	Fri	Sat	Sun
		1	2	3	4	5
6	7	8	9	10	11	12
13	14	15	16	17	18	19
20	21	22	23	24	25	26
27	28	29	30	31