本帖最后由 作者 于 2010-7-20 18:52:10 编辑
;;;------------------------------------------------------------- ;;; ;;; ;;; 命令名:BGPLZK:钻孔 ;;; ;;; 从文本文件中读入数据,在平面图中写入勘探点 ;;; 数据文本文件格式为:孔号 X坐标 Y坐标 Z坐标 孔深 土层厚 ;;; (数据间留一空格,数据为空时补为0) ;;; ;;; 作者:凉开水 ;;; ;;; 2005.12.31 ;;; ;;;----------------------------------------------------------------------- (defun c:BGPLZK (/ oce1 oce2 oce3 oce4 oce5 oce6 x fn1 f n nam dat1 n1 x1 y1 z1 h1 ht p1 p2 p3 p4 p5 p6 p7 p8 p9 n2 z2 h2 ht2 old1 en er )
(setvar "errno" 0);;;系统变量错误代码归零 (setq old1 *error*);;;保存原错误函数内容 (defun *error* (msg);;;定义错误函数 (setq en (getvar "errno"));;;提取错误代码 (setq er (strcat "错误代码=" (itoa en) "\n保哥哥提示:钻孔数据文件格式错误," "\n 将鼠标指向菜单栏命令," "\n 并参考命令栏处帮助说明。" "\n" "\n 文件格式为 .txt 每孔数据为一行" "\n 孔号 X坐标 Y坐标 Z坐标 孔深 土层厚" "\n(数据间留一空格,数据为空时应补为0)" ) ) (alert er);;;以对话框显示错误码和错误信息 (setq *error* old1);;;恢复原有错误函数内容 )
;;;系统变量 (command "undo" "be") (setq oce1 (getvar "cmdecho");;;保存命令响应原变量值 oce2 (getvar "OSNAPCOORD");;;保存坐标数据优先级原变量值 oce3 (getvar "OSMODE");;;捕捉变量 oce4 (getvar "ANGDIR");;;角度正方向 oce5 (getvar "ANGBASE");;;基准角度 oce6 (getvar "dimzin");;;控制主单位值作消零处理 ) (setvar "cmdecho" 0);;;关闭命令响应 (setvar "OSNAPCOORD" 1);;;坐标数据优先级设为:键盘输入替代对象捕捉设置 (setvar "OSMODE" 7095);;;改变捕捉模式 (setvar "ANGDIR" 0);;;角度正方向为逆时针 (setvar "ANGBASE" 0);;;基准角度东方为0 (setvar "dimzin" 0);;;不对主单位值作消零处理 ;;;系统变量
(if (not (setq x (getreal "\n请输入比例<1>: "))) (setq x 1) ) (if (= (Tblsearch "style" "BG_ST") nil) (command "-style" "BG_ST" "宋体" 0 0.8 0 "n" "n");;;文字样式 ) (command "textstyle" "BG_ST") (If (= (Tblsearch "layer" "勘探点") nil) (command "-layer" "n" "勘探点" "c" 5 "勘探点" "s" "勘探点" "");;;定义图层 ) (command "-layer" "c" 5 "勘探点" "s" "勘探点" "") (setq h (* x 3.8));;;字体高度 (if (setq nam (getfiled "钻孔数据格式:孔号 X坐标 Y坐标 Z高程 孔深 土层厚(数据空时补为0)" "" "txt" 0 ) );;;打开文件 (progn (setq f (open nam "r"));;;对文件进行读操作 (if (setq dat1 (read-line f));;;读入数据 (progn (while (/= dat1 nil) (setq dat1 (strcat "(" dat1 ")") dat1 (read dat1) );;;钻孔数据转为序列 (if (/= (type dat1) nil) (progn (setq n1 (nth 0 dat1);;;孔号 x1 (nth 1 dat1);;;X坐标 y1 (nth 2 dat1);;;Y坐标 z1 (nth 3 dat1);;;高程 h1 (nth 4 dat1);;;孔深 ht (nth 5 dat1);;;土层厚 p1 (list y1 x1 z1);;;钻孔坐标 ) (command "circle" p1 (* x 2));;;画钻孔圆圈;;;插入钻孔圆圈 (setq p2 (list (- (car p1) (* x 10)) (- (cadr p1) (* x 0.2)) (caddr p1) );;;孔号插入位置 p3 (list (+ (car p1) (* x 11)) (- (cadr p1) (* x 0.2)) (caddr p1) );;;高程插入位置 p4 (list (+ (car p1) (* x 11)) (- (cadr p1) (* x 0.5)) (caddr p1) );;;土层厚插入位置 p5 (list (+ (car p1) (* x 4)) (cadr p1) (caddr p1) );;;隔线起点 p6 (list (+ (car p1) (* x 18)) (cadr p1) (caddr p1) );;;隔线终点 p7 (list (- (car p1) (* x 10)) (- (cadr p1) (* x 0.5)) (caddr p1) );;;孔深插入位置 p8 (list (- (car p1) (* x 4)) (cadr p1) (caddr p1) );;;隔线起点 p9 (list (- (car p1) (* x 16)) (cadr p1) (caddr p1) );;;隔线终点 ) (setq n2 (vl-symbol-name n1);;;孔号转为字符串 z2 (rtos z1 2 2);;;高程转为字符串 h2 (rtos h1 2 2);;;孔深转为字符串 ht2 (rtos ht 2 2);;;土层厚度转为字符串 ) (command "zoom" "w" (polar p1 (* pi 0.5) (* x 50)) (polar p1 (* pi 1.5) (* x 50)) ) (command "text" "bc" p2 h 0 n2);;;写孔号 (command "text" "bc" p3 h 0 z2);;;写孔口高程 (command "text" "tc" p7 h 0 h2);;;写孔深 (command "text" "tc" p4 h 0 ht2);;;写土层厚 (command "line" p5 p6 "");;;画高程与土厚隔线 (command "line" p8 p9 "");;;画孔号与孔深隔线 ) ) (setq dat1 (read-line f));;;读入下一行数据 ) ) ) ) ) (close f);;;关闭文件
;;;还原系统变量值 (setvar "cmdecho" oce1);;;恢复命令响应 (setvar "OSNAPCOORD" oce2);;;恢复坐标数据优先级设置 (setvar "OSMODE" oce3);;;恢复捕捉模式 (setvar "ANGDIR" oce4);;;恢复角度正方向 (setvar "ANGBASE" oce5);;;恢复基准角度 (setvar "dimzin" oce6);;;恢复主单位值消零处理 ;;;还原系统变量值
(setq *error* old1);;;恢复原有错误函数内容 (command "undo" "e") (princ) )
|