批量展勘察点程序的申请

fz5208

因为是做工程勘察的工作，其实用到比较多的布孔。现在要求是这样的：1：格式TXT文本：孔号，X（A）坐标，Y（B）坐标，孔深（标高），孔类别 2：在CAD上选择这样的文本格式来插入相应的孔类别的块。（孔类别是1-7数字编号，1-7对应代表做好的专业图块），3：思路是：插入（-insert）-块（1-7编号中1个数字）-指定插入点（X（A）坐标，Y（B）坐标）-输入 X 比例因子（自己选择 比例因子）-输入 Y 比例因子（自己选择 比例因子）-指定旋转角度 （自己选择旋转角度，一般也是旋转零度了 ） 这样就完成在指定坐标位置输入了指定的图块。4:在CAD上选择这样的文本格式来插入孔号与孔深（标高）文本.4：思路是 单行文字（dtext）-指定文字起点（也就是坐标）-指定字高（自己设置）-指定文字的旋转角度（自己设置，一般也是旋转零度了）-输入文字（也就是孔号）

 

呵呵，也不知道说清楚没有了。就是一个写文本（展孔号）和一个插入已经做好的块（展点）2个步骤的。也可以分开写程序。当然中间的设置比例因子和字高、旋转角度什么的，提前设置好，也可以默认的。

下面一楼是 1：文本数据格式  2：做好的1-7编号的块  3：最终的效果图

最后还有个小小的要求的。如果能成功的话。可以分解成几个小程序的。1：只展孔号 （要高程（孔深）和不要高程（孔深）2种）2：只展孔类别 3：只展孔（只是圆，不分类别）呵呵也许要求高了。先谢谢能帮助的人。

 

fz5208

孔号	X坐标	Y坐标	孔深（高程）	类别
zk1	114103.770	42806.160	208.74	2
zk2	114224.800	42925.540	219.08	3
zk3	114310.240	43009.810	213.33	4
zk4	114381.430	43080.030	212.47	5
zk5	114488.220	43185.370	212.43	6
zk6	114033.550	42877.360	198.01	7
zk7	114154.580	42996.740	212.87	1
zk8	114240.010	43081.000	213.05	2
zk9	114311.210	43151.230	212.46	3
zk10	114418.000	43256.560	212.95	4
zk11	113963.330	42948.550	198.61	5
zk12	114084.360	43067.930	212.32	6
zk13	114169.790	43152.200	213.37	7
zk14	114240.980	43222.420	211.83	4
zk15	114347.780	43327.760	207.12	5
zk16	113942.260	42969.910	194.81	6
zk17	114063.290	43089.290	199.85	7
zk18	114148.720	43173.560	203.12	1
zk19	114219.920	43243.780	201.23	2
zk20	114326.710	43349.120	199.31	3
zk21	113907.150	43005.510	184.58	4
zk22	114028.180	43124.890	189.12	5
zk23	114113.610	43209.150	193.75	6
zk24	114184.800	43279.380	193.13	7
zk25	114291.600	43384.710	191.16	1

 

 

这个是文本格式

fz5208

目前我是在excel中实现了部分的功能，（1：只是展孔就是圆了，不分类别的。2：展孔类别就是做了7个块放入CAD的文件搜索目录下然后在相应坐标位置插入块 3：只是展孔号（孔号作为文本）4：但是就是高程（孔深）也展上去的时候，怎么实现孔号在上，高程（孔深）在下。中间用一横线分开。且在孔的外面就没有办法实现的），但是数据很多的时候，excel很慢也很容易死机的呢。现在就是请版主帮助编写程序来解决了。谢谢。

yxr_MJTD

用什么语言写啊?

fz5208

lsp程序可行吗？我不太懂CAD 的编程的。

展点坐标程序原代码！
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=8422
论坛里面这个程序很类似的呢，其实就把坐标点展到cad图纸上面去的。

fz5208

难道我的问题很复杂吗？请版主抽时间看看。谢谢，
我传一个凉开水工具里面的一个展点的LSp程序给大家参考下。希望有灵感了。
;;;
;;;  命令名：BGZKGY  纲要布置钻孔
             BGSJGY　纲要布置竖井
            
             BGZK 　 手动布置钻孔
             BGSJ    手动布置竖井
   　　　　　BGTC    手动布置探槽
            
             BGPLZK  批量布置钻孔
             BGPLSJ　批量布置竖井
             BGPLTC　批量布置探槽
;;;
;;;  在平面图中写入勘探点连续编号
;;;
;;;  作者：凉开水
;;;
;;;  2005.05.28
;;;
;;;-------------------------------------------------------------
(defun c:BGZKGY (/ 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 10))
           (- (cadr p1) (* x 0.2))
           (caddr p1)
         );;;组成高程插入位置
      p4
         (list (+ (car p1) (* x 10))
           (- (cadr p1) (* x 0.5))
           (caddr p1)
         );;;组成孔深插入位置
      p5
         (list (+ (car p1) (* x 4))
           (cadr p1)
           (caddr p1)
         );;;隔线起点
      p6
         (list (+ (car p1) (* x 16))
           (cadr p1)
           (caddr p1)
         );;;隔线终点
    )
    (command "text" "bc" p3 h1 0 zkn);;;写勘探点编号
    (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)
)
;;;
;;;-------------------------------------------------------------
;;;

;;;
;;;-------------------------------------------------------------
(defun c:BGSJGY (/ 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 "SJ" (itoa n1)));;;组成勘探点的代号

;;;循环画勘探点------
  (while (/= p1 nil)
    (command "pline" (list (+ (car p1)(* x 2))(- (cadr p1)(* x 2))(caddr p1))
                     "w" (* x 0.3) (* x 0.3 )
                     (list (- (car p1)(* x 2))(- (cadr p1)(* x 2))(caddr p1))
                     (list (- (car p1)(* x 2))(+ (cadr p1)(* x 2))(caddr p1))
                     (list (+ (car p1)(* x 2))(+ (cadr p1)(* x 2))(caddr p1))
                     "c"
    );;;插入竖井方框
    (setq p2 (list (- (car p1) (* x 4))
           (cadr p1)
           (caddr p1)
         );;;组成编号的插入位置
      p3
         (list (+ (car p1) (* x 10))
           (- (cadr p1) (* x 0.2))
           (caddr p1)
         );;;组成高程插入位置
      p4
         (list (+ (car p1) (* x 10))
           (- (cadr p1) (* x 0.5))
           (caddr p1)
         );;;组成孔深插入位置
      p5
         (list (+ (car p1) (* x 4))
           (cadr p1)
           (caddr p1)
         );;;隔线起点
      p6
         (list (+ (car p1) (* x 16))
           (cadr p1)
           (caddr p1)
         );;;隔线终点
    )
    (command "text" "bc" p3 h1 0 zkn);;;写勘探点编号
    (command "text" "tc" p4 h1 0 "00.00");;;写孔深
    (command "line" p5 p6 "");;;画高程与孔深隔线
    (setq
      n1  (1+ n1);;;下一序号
      zkn (strcat "SJ" (itoa n1));;;下一勘探点编号
      p1  (getpoint "\n下一插入点<退出>: ");;;指定下一勘探点插入位置
    )
  )
;;;循环画勘探点------


;;;还原系统变量值
  (setvar "cmdecho" oce1);;;恢复命令响应
  (setvar "OSNAPCOORD" oce2);;;恢复坐标数据优先级设置
  (setvar "OSMODE" oce3);;;恢复捕捉模式
  (setvar "ANGDIR" oce4);;;恢复角度正方向
  (setvar "ANGBASE" oce5);;;恢复基准角度
;;;还原系统变量值

  (command "pline" (list 0 0 0) "w" 0 0 "");;;恢复0线宽
  (command "undo" "e")
  (princ)
)
;;;
;;;-------------------------------------------------------------
;;;

;;;
;;;-------------------------------------------------------------
(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)
)
;;;
;;;-------------------------------------------------------------
;;;

;;;
;;;-------------------------------------------------------------
(defun c:BGSJ (/ 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 "SJ" (itoa n1)));;;组成勘探点的代号

;;;循环画勘探点------
  (while (/= p1 nil)
    (command "pline" (list (+ (car p1)(* x 2))(- (cadr p1)(* x 2))(caddr p1))
                     "w" (* x 0.3) (* x 0.3 )
                     (list (- (car p1)(* x 2))(- (cadr p1)(* x 2))(caddr p1))
                     (list (- (car p1)(* x 2))(+ (cadr p1)(* x 2))(caddr p1))
                     (list (+ (car p1)(* x 2))(+ (cadr p1)(* x 2))(caddr p1))
                     "c"
    );;;插入竖井方框
    (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 "SJ" (itoa n1));;;下一勘探点编号
      p1  (getpoint "\n下一插入点<退出>: ");;;指定下一勘探点插入位置
    )
  )
;;;循环画勘探点------


;;;还原系统变量值
  (setvar "cmdecho" oce1);;;恢复命令响应
  (setvar "OSNAPCOORD" oce2);;;恢复坐标数据优先级设置
  (setvar "OSMODE" oce3);;;恢复捕捉模式
  (setvar "ANGDIR" oce4);;;恢复角度正方向
  (setvar "ANGBASE" oce5);;;恢复基准角度
;;;还原系统变量值

  (command "pline" (list 0 0 0) "w" 0 0 "");;;恢复0线宽
  (command "undo" "e")
  (princ)
)
;;;
;;;-------------------------------------------------------------
;;;

;;;
;;;-------------------------------------------------------------
(defun c:BGTC (/ oce1 oce2 oce3 oce4 oce5 fn1 x n1 h1 p1 p2 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 "TC" (itoa n1)));;;组成勘探点的代号

;;;循环画勘探点------
  (while (/= p1 nil)
    (command "pline" (list (+ (car p1)(* x 4))(- (cadr p1)(* x 2))(caddr p1))
                     "w" (* x 0.3) (* x 0.3 )
                     (list (- (car p1)(* x 4))(- (cadr p1)(* x 2))(caddr p1))
                     (list (- (car p1)(* x 4))(+ (cadr p1)(* x 2))(caddr p1))
                     (list (+ (car p1)(* x 4))(+ (cadr p1)(* x 2))(caddr p1))
                     "c"
    );;;插入探槽方框
    (setq p2 (list (- (car p1) (* x 6))
           (cadr p1)
           (caddr p1)
         );;;组成编号的插入位置
    )
    (command "text" "mr" p2 h1 0 zkn);;;写勘探点编号
    (setq
      n1  (1+ n1);;;下一序号
      zkn (strcat "TC" (itoa n1));;;下一勘探点编号
      p1  (getpoint "\n下一插入点<退出>: ");;;指定下一勘探点插入位置
    )
  )
;;;循环画勘探点------


;;;还原系统变量值
  (setvar "cmdecho" oce1);;;恢复命令响应
  (setvar "OSNAPCOORD" oce2);;;恢复坐标数据优先级设置
  (setvar "OSMODE" oce3);;;恢复捕捉模式
  (setvar "ANGDIR" oce4);;;恢复角度正方向
  (setvar "ANGBASE" oce5);;;恢复基准角度
;;;还原系统变量值

  (command "pline" (list 0 0 0) "w" 0 0 "");;;恢复0线宽
  (command "undo" "e")
  (princ)
)
;;;
;;;-------------------------------------------------------------
;;;
;;;
;;;  命令名：BGPLZK:钻孔   BGPLSJ:竖井　　BGPLTC:探槽
;;;
;;;  从文本文件中读入数据，在平面图中写入勘探点
;;;  数据文本文件格式为：孔号  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)
)
;;;
;;;-----------------------------------------------------------------------
;;;
;;;
;;;-----------------------------------------------------------------------
;;;
(defun c:BGPLSJ    (/ 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 "pline" (list (+ (car p1)(* x 2))(- (cadr p1)(* x 2))(caddr p1))
                                 "w" (* x 0.3) (* x 0.3 )
                                 (list (- (car p1)(* x 2))(- (cadr p1)(* x 2))(caddr p1))
                                 (list (- (car p1)(* x 2))(+ (cadr p1)(* x 2))(caddr p1))
                                 (list (+ (car p1)(* x 2))(+ (cadr p1)(* x 2))(caddr p1))
                                 "c"
                );;;插入竖井方框
                (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 "pline" (list 0 0 0) "w" 0 0 "");;;恢复0线宽
  (command "undo" "e")
  (princ)
)
;;;
;;;-----------------------------------------------------------------------
;;;

;;;
;;;-----------------------------------------------------------------------
;;;
(defun c:BGPLTC    (/ oce1 oce2 oce3 oce4 oce5 oce6 x fn1 f n nam dat1 n1
                   x1 y1 z1 p1 p2 n2 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);;;高程
              p1 (list y1 x1 z1);;;探槽坐标
        )
                (if (= z1 nil) (*error*))
        (command "pline" (list (+ (car p1)(* x 4))(- (cadr p1)(* x 2))(caddr p1))
                                 "w" (* x 0.3) (* x 0.3 )
                                 (list (- (car p1)(* x 4))(- (cadr p1)(* x 2))(caddr p1))
                                 (list (- (car p1)(* x 4))(+ (cadr p1)(* x 2))(caddr p1))
                                 (list (+ (car p1)(* x 4))(+ (cadr p1)(* x 2))(caddr p1))
                                 "c"
                );;;插入探槽方框
                (setq p2 (list (- (car p1) (* x 6))
                       (cadr p1)
                       (caddr p1)
                     );;;组成编号的插入位置
                )
        (setq n2 (vl-symbol-name n1));;;探槽号转为字符串
        (command "zoom"
             "w"
             (polar p1 (* pi 0.5) (* x 50))
             (polar p1 (* pi 1.5) (* x 50))
        )
        (command "text" "mr" p2 h 0 n2);;;写探槽号
          )
        )
        (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 "pline" (list 0 0 0) "w" 0 0 "");;;恢复0线宽
  (command "undo" "e")
  (princ)
)
;;;
;;;------------------------------------------------------------------
;;;

fz5208

发了凉开水的程序希望不要引起版权的问题呀，呵呵。

fz5208

 http://bbs.mjtd.com/forum.php?mod=viewthread&tid=14829 看来找到类似的帖子了呢，呵呵，和我们的要求很像的，不知道实现的过程是不是一样呢。

furuiyong

本人vba实现该功能，email：furuiyong@163.com可以交流