希望可以将布置了的钻孔坐标信息写入到excel中（支持自定义坐标）

daiguafan

现有如下两个代码，希望实现布置好钻孔后，直接将已布置的钻孔，按照钻孔编号，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)
)
;;;
;;;-------------------------------------------------------------------
;;;

技术工作室

支持一下顶一个