希望可以将布置了的钻孔坐标信息写入到excel中（支持自定义坐标）
本帖最后由 daiguafan 于 2011-3-6 23:14 编辑现有如下两个代码，希望实现布置好钻孔后，直接将已布置的钻孔，按照钻孔编号，x坐标，y坐标方式写入到excel或者text中
希望支持自定义坐标。最好支持天正，呵呵。麻烦各位了
;;;ZKbz 手动布置钻孔
(defun c:BGZK (/ oce1 oce2 oce3 oce4 oce5 fn1 x n1 h1 p1 p2 p3
p4 p5 p6 zkn)
;;;系统变量
(command "undo" "be")
(setq
oce1 (getvar "cmdecho");;;保存命令响应原变量值
oce2 (getvar "OSNAPCOORD");;;保存坐标数据优先级原变量值
oce3 (getvar "OSMODE");;;捕捉变量
oce4 (getvar "ANGDIR");;;角度正方向
oce5 (getvar "ANGBASE");;;基准角度
)
(setvar "cmdecho" 0);;;关闭命令响应
(setvar "OSNAPCOORD" 1);;;坐标数据优先级设为：键盘输入替代对象捕捉设置
(setvar "OSMODE" 7095);;;改变捕捉模式
(setvar "ANGDIR" 0);;;角度正方向为逆时针
(setvar "ANGBASE" 0);;;基准角度东方为0
;;;系统变量
(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" "勘探点" "")
(if (not (setq x (getreal "\n请输入比例<1>: ")))
(setq x 1)
)
(if (not (setq n1 (getint "\n钻孔起始号 <1>: ")))
(setq n1 1)
)
(setq p1 (getpoint "\n指定钻孔插入点<退出>: "));;;指定勘探点的插入位置
(setq h1 (* x 3.8));;;字体高度
(setq zkn (strcat "zk" (itoa n1)));;;组成勘探点的代号
;;;循环画勘探点------
(while (/= p1 nil)
(command "circle" p1 (* x 2));;;画钻孔圆圈
(setq p2 (list (- (car p1) (* x 4))
(cadr p1)
(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)
);;;隔线终点
)
(command "text" "mr" p2 h1 0 zkn);;;写勘探点编号
(command "text" "bc" p3 h1 0 "000.00");;;写孔口高程
(command "text" "tc" p4 h1 0 "00.00");;;写孔深
(command "line" p5 p6 "");;;画高程与孔深隔线
(setq
n1(1+ n1);;;下一序号
zkn (strcat "zk" (itoa n1));;;下一勘探点编号
p1(getpoint "\n下一插入点<退出>: ");;;指定下一勘探点插入位置
)
)
;;;循环画勘探点------
;;;还原系统变量值
(setvar "cmdecho" oce1);;;恢复命令响应
(setvar "OSNAPCOORD" oce2);;;恢复坐标数据优先级设置
(setvar "OSMODE" oce3);;;恢复捕捉模式
(setvar "ANGDIR" oce4);;;恢复角度正方向
(setvar "ANGBASE" oce5);;;恢复基准角度
;;;还原系统变量值
(command "undo" "e")
(princ)
)
;;;
;;; 命令名: BGPT1输出数学坐标至电子表格
;;; BGPT2输出地理坐标至电子表格
;;;
;;; 将CAD中测量的坐标点数据输出到.xls(电子表格)文件
;;;
;;; 凉开水
;;;
;;; 2005.06.02
;;;
;;;------------------------------------------------------------------------
(defun C:BGPT1 (/ nam f n1 n2 pt)
(if (setq nam (getfiled "数学坐标数据保存至(电子表格.xls): " "" "xls" 9))
(progn
(setq f (open nam "w"))
(write-line "数学坐标" f)
(write-line "X
Y
Z" f)
(setq n1 0)
(while (setq pt (getpoint "\n坐标点<退出> : "))
(write-line
(strcat (rtos (car pt) 2 2)
"
"
(rtos (cadr pt) 2 2)
"
"
(rtos (caddr pt) 2 2)
)
f
)
(setq n1 (1+ n1))
)
(setq n2 (strcat "共" (rtos n1) "组数据"))
(prin1 n2 f)
(close f)
)
)
(princ)
)
;;;
;;;------------------------------------------------------------------------
;;;
;;;
;;;------------------------------------------------------------------------
(defun C:BGPT2 (/ nam f n1 n2 pt)
(if (setq nam (getfiled "地理坐标数据保存至(电子表格.xls): " "" "xls" 9))
(progn
(setq f (open nam "w"))
(write-line "地理坐标" f)
(write-line "X
Y
Z" f)
(setq n1 0)
(while (setq pt (getpoint "\n坐标点<退出> : "))
(write-line
(strcat (rtos (cadr pt) 2 2)
"
"
(rtos (car pt) 2 2)
"
"
(rtos (caddr pt) 2 2)
)
f
)
(setq n1 (1+ n1))
)
(setq n2 (strcat "共" (rtos n1) "组数据"))
(prin1 n2 f)
(close f)
)
)
(princ)
)
;;;
;;;-------------------------------------------------------------------
;;;
支持一下顶一个
页:
[1]