[求助]求助改个展点的程序的

fz5208

;;;-------------------------------------------------------------
;;;
;;;
;;;  命令名：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)
)

fz5208

(command "circle" p1 (* x 2));;;画钻孔圆圈;;;插入钻孔圆圈 -这个不好能不能改成批量插入指定块（已经做好的块放在CAD目录下）
ht (nth 5 dat1);;;土层厚    z1 (nth 3 dat1);;;高程  这两个参数不需要。

 

fz5208

第一个表格数据直接复制在TXT文本数据是原程序要求的，第二个表格数据直接复制在TXT文本数据是要修改程序要求的，第三个是要最后实现的效果图，附件是做好的图例块。