设为首页收藏本站转
发帖领奖家园QQ群申请版主版主评价切换到宽版

 找回密码
 立即注册

QQ登录

只需一步，快速开始

扫一扫，访问微社区

晓东CAD家园-论坛»论坛 › ╃CAD编程开发 › A/VLISP › 批量导点绘图程序
12下一页
返回列表 发新帖
查看: 3060|回复: 15

[原创] 批量导点绘图程序

[复制链接]
GTJ116600
发表于 2013-7-15 10:28:53 | 显示全部楼层 |阅读模式
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要 登录 才可以下载或查看，没有账号？立即注册

×
本帖最后由 GTJ116600 于 2013-7-15 14:51 编辑

程序功能：能将指定目录下的txt文本内的坐标文件，整理后批量导入绘制图形。
程序可根据各行业要求进一步整理成依据附有属性的坐标文件，自动绘制特定实体。
如：测量行业中的自动绘制陡坎，墙、井、道路等。

希望各位大神多提宝贵意见，以便进一步改进
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;批量导点绘图程序;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;|  需要完善的内容
    1.删除临时文件
    2.提出宗地号，用地面积和项目名称
    3.在图上标注宗地号、用地面积和项目名称
    4.需要建立图层、设立字体和字体大小、字体颜色 |;
                                                     by   gtj116600@163.com    QQ 1085566757
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;批量整理TXT文本程序;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun zyj-silenceexit( / *error*)
   (t (setq *error* strcat))
)
(defun c:pldraw( / ffn ph fn i n n1 fn1 fn2 fn3 str int len lst)
   (setq Vcmdecho (getvar "cmdecho") Vosmode (getvar "osmode"))
   (setvar "cmdecho" 0)
   (setvar  "osmode" 0)      
   (setq ffn (getfiled " 打开文件 "  "" "txt" 2))
   (or ffn (zyj-silenceexit))
   (setq ph (vl-filename-directory ffn))           ;获取文件目录名
   (setq fn (vl-directory-files ph "*.txt" 1))     ;返还指定目录下不含目录名的所有文件名称
   (setq i -1 n (length fn))
   (repeat n
     (setq n1 (nth (setq i (1+ i)) fn) fn1 (strcat (vl-string-subst "/" "\\" ph) "/" n1))   
      (setq fn2 (open fn1 "r")
            fn3 (open (setq fn4 (strcat "d:/" (itoa (1+ i)) ".txt")) "w")
            lst (cons fn4 lst)
     )
     (while (setq str (read-line fn2))             ;整理TXT文件
       (if (wcmatch str "J*,  J*")
         (progn
            (setq int (vl-string-search ",1," str)
                  len (strlen str)
                  str (substr str (+ int 4))
            )
            (princ str fn3)
            (princ "\n" fn3)
         )
       )  
     )  
     (close fn2)
     (close fn3)  
  )
  (setq i -1 n (length lst))
  (repeat n
     (setq fn4 (nth (setq i (1+ i)) lst))
     (setq fn5 (open fn4 "r"))
;    (setq pt (read-line fn5))
     (command "pline")
     (while (setq pt (read-line fn5))
        (setq pos (vl-string-search "," pt)
              strlef (substr pt 1 pos)
              strrig (substr pt (setq pos (+ pos 2)))                  
              pt  (vl-string-subst strrig strlef pt)
              pos (vl-string-search "," pt)
              pt (vl-string-subst strlef strrig pt (setq pos (1+ pos)))                 
        )
        (command pt)
    )
    (command "c")
    (close fn5)
    (vl-file-delete fn4)
  )
  (command "zoom" "e")
  (setvar "cmdecho" Vcmdecho)
  (setvar  "osmode" Vosmode)  
  (princ)
)
(princ "\n批量导点绘图程序（先整理TXT文件后绘图）已加载成功，请在命令行输入pldraw命令唤醒她!!!
       \n编程者 张亚军 电子邮箱gtj116600@163.com")

根据eachy前辈的指点，调整了一下绘图方式，由边读点边绘图，调整为读取点后再绘图。
另一个问题，向前辈请教一下， lisp的表最大长度是多少？采用读取点后再绘图的方式读
点数量超过lisp表长时有没有什么好的处理办法

  1. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;批量导点绘图程序  版本号v1.01;;;;;;;;;;;;;;;;;;;;;;;;;
  2. ;|  需要完善的内容
  3.     1.提出宗地号，用地面积和项目名称
  4.     2.在图上标注宗地号、用地面积和项目名称
  5.     3.需要建立图层、设立字体和字体大小、字体颜色  
  6.     作者  张亚军  邮箱gtj116600@163.com    QQ 1085566757  编制日期 2013年7月15日  |;
  7. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;批量整理TXT文本程序;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  8. (defun zyj-silenceexit( / *error*)
  9.    (t (setq *error* strcat))
  10. )
  11. (defun c:pldraw( / Vcmdecho Vosmode ffn ph fn i n n1 fn1 fn2 fn3 lst
  12.    str int len pt fn4 fn5 strlef strrig pos j datalist)
  13.    (setq Vcmdecho (getvar "cmdecho") Vosmode (getvar "osmode"))
  14.    (setvar "cmdecho" 0)
  15.    (setvar "osmode" 0)      
  16.    (setq ffn (getfiled " 打开文件 "  "" "txt" 2))
  17.    (or ffn (zyj-silenceexit))
  18.    (setq ph (vl-filename-directory ffn))           ;获取文件目录名
  19.    (setq fn (vl-directory-files ph "*.txt" 1))     ;返还指定目录下不含目录名的所有文件名称
  20.    (setq i -1 n (length fn) lst '())
  21.    (repeat n
  22.      (setq n1 (nth (setq i (1+ i)) fn) fn1 (strcat (vl-string-subst "/" "\\" ph) "/" n1))   
  23.       (setq fn2 (open fn1 "r")
  24.             fn3 (open (setq fn4 (strcat "d:/" (itoa (1+ i)) ".txt")) "w")
  25.             lst (cons fn4 lst)
  26.      )
  27.      (while (setq str (read-line fn2))             ;整理TXT文件
  28.        (if (wcmatch str "J*,  J*")
  29.          (progn
  30.             (setq int (vl-string-search ",1," str)
  31.                   len (strlen str)
  32.                   str (substr str (+ int 4))
  33.             )
  34.             (princ str fn3)
  35.             (princ "\n" fn3)
  36.          )
  37.        )  
  38.      )  
  39.      (close fn2)
  40.      (close fn3)  
  41.   )
  42.   (defun txtinlist(ffname / datalist pt)             ;;;将TXT文本文件导出整理成表
  43.      (setq pt (read-line ffname) datalist '())
  44.      (or pt (zyj-silenceexit))
  45.      (while pt
  46.         (setq datalist (cons pt datalist))
  47.         (setq pt (read-line ffname))
  48.      )
  49.      (setq datalist (reverse datalist))   
  50.   )
  51.   (setq i -1)  
  52.   (repeat n
  53.      (setq fn4 (nth (setq i (1+ i)) lst))
  54.      (setq fn5 (open fn4 "r"))
  55.      (setq datalist  (txtinlist fn5) j -1)
  56. ;    (setq pt (read-line fn5) j -1)
  57.      (command "pline")
  58.      (while (setq pt (nth (setq j (1+ j)) datalist))
  59.         (setq pos (vl-string-search "," pt)
  60.               strlef (substr pt 1 pos)
  61.               strrig (substr pt (setq pos (+ pos 2)))                  
  62.               pt  (vl-string-subst strrig strlef pt)
  63.               pos (vl-string-search "," pt)
  64.               pt (vl-string-subst strlef strrig pt (setq pos (1+ pos)))                 
  65.         )
  66.         (command pt)
  67.      )
  68.      (command "c")
  69.      (close fn5)
  70.      (vl-file-delete fn4)
  71.    )
  72.    (command "zoom" "e")
  73.    (setvar "cmdecho" Vcmdecho)
  74.    (setvar  "osmode" Vosmode)  
  75.    (princ)
  76. )
  77. (princ "\n批量导点绘图程序已加载成功，请在命令行输入pldraw命令唤醒她!!!")








程序

exe.zip

10.09 KB, 下载次数: 36, 下载积分: D豆 -1 , 活跃度 1

试验数据

批量导点绘图程序（V1.0）[1].lsp

2.49 KB, 下载次数: 37, 下载积分: D豆 -1 , 活跃度 1

源程序

批量导点绘图程序（V1.01）（源码）.lsp

2.84 KB, 下载次数: 55, 下载积分: D豆 -1 , 活跃度 1

源程序

相关帖子

论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复

使用道具 举报

水沙漠
发表于 2013-7-15 10:53:21 | 显示全部楼层
下来试试看！

点评

GTJ116600
呵呵，需要配合附图使用，应为TXT文本内容不同，程序需要微小调整  详情 回复 发表于 2013-7-15 12:21
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

GTJ116600
 楼主| 发表于 2013-7-15 12:21:05 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
本帖最后由 GTJ116600 于 2013-7-15 12:23 编辑
水沙漠 发表于 2013-7-15 10:53
下来试试看！


呵呵，谢谢支持。本程序需要配合附件（txt文件夹）使用，使用时点选文件夹内的任意一个TXT文本即可。

注：TXT文本内容不同，程序需要微小调整


论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

eachy

已领礼包: 593个

财富等级: 财运亨通
发表于 2013-7-15 13:13:09 来自手机 | 显示全部楼层
一般一次把文件读完构造表，关闭，然后再用表绘图，获取目录可以使用acet提供的一个函数，不用选文件

点评

GTJ116600
呵呵，谢谢eachy前辈指点，我调一下程序，重新传上来  详情 回复 发表于 2013-7-15 13:15
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

GTJ116600
 楼主| 发表于 2013-7-15 13:15:47 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
eachy 发表于 2013-7-15 13:13
一般一次把文件读完构造表，关闭，然后再用表绘图，获取目录可以使用acet提供的一个函数，不用选文件

呵呵，谢谢eachy前辈指点，我调一下程序，重新传上来
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

炫翔

已领礼包: 1742个

财富等级: 堆金积玉
发表于 2013-7-15 13:35:49 | 显示全部楼层
{:soso_e141:}是不是麻烦了点，GU版的那个框选输出图形的LISP 不错

点评

GTJ116600
翔版主，刚学编程不久。还未掌握编程要领，目前还停留在研究函数阶段。 另G版的框选输出图形LISP能给个链接么。向G版学习学习 以下是我处理的txt文本的数据，编程时需要先处理然后才能绘图。 [属性描述] 坐标系=  详情 回复 发表于 2013-7-15 14:20
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

zhangq_cai1

已领礼包: 862个

财富等级: 财运亨通
发表于 2013-7-15 14:07:40 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
学习了~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~·
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复

使用道具 举报

st788796

已领礼包: 1268个

财富等级: 财源广进
发表于 2013-7-15 14:10:08 | 显示全部楼层
获取指定目录下文件
http://www.xdcad.net/forum/forum.php?mod=viewthread&tid=259070

点评

GTJ116600
谢谢支持。看了下。那个程序如下 批量处理打开指定目录下的所有dwg文件 (defun c:test () ;(vl-load-com) (setq dir (getstring "Input Directory: ")) (setq ff (vl-directory-files dir "*.dwg" 1))  详情 回复 发表于 2013-7-15 14:38
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

GTJ116600
 楼主| 发表于 2013-7-15 14:20:31 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
本帖最后由 GTJ116600 于 2013-7-15 14:41 编辑
炫翔 发表于 2013-7-15 13:35
是不是麻烦了点，GU版的那个框选输出图形的LISP 不错


翔版主，刚学编程不久。还未掌握编程要领，目前还停留在研究函数阶段。
我这个程序可将多个TXT文件内的数据整理后批量绘图，不局限一个文件。

另G版的框选输出图形LISP能给个链接么。向G版学习学习
以下是我批量处理的txt文本的一个数据，编程时需要先处理然后才能绘图。
[属性描述]
坐标系=80西安坐标系
几度分带=3
投影类型=高斯克吕格
计量单位=米
带号=41
精度=0.0100
转换参数=,,,,,,
[地块坐标]
4,1.6003,05111004,华弘精密,面,J51G022031,******,,@
J1,1,4329855.8500,41406083.8200
J2,1,4329904.3300,41405965.4000
J3,1,4329787.1600,41405916.4800
J4,1,4329740.3600,41406031.9000

上述坐标是笛卡尔坐标系下的坐标，绘图时需转成高斯坐标系下的坐标
其中的05111004是宗地号，华弘精密是项目名称，J51G022031是该图在
8080西安坐标系下的图幅号。上述信息目前还未处理。


论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

GTJ116600
 楼主| 发表于 2013-7-15 14:38:44 | 显示全部楼层
st788796 发表于 2013-7-15 14:10
获取指定目录下文件
http://www.xdcad.net/forum/forum.php?mod=viewthread&tid=259070


谢谢支持。看了下。那个程序如下
批量处理打开指定目录下的所有dwg文件
[php]
(defun c:test ()
  ;(vl-load-com)
  (setq dir (getstring "Input Directory: "))
  (setq ff (vl-directory-files dir "*.dwg" 1))
  (foreach i ff
    (vla-open
      (vla-get-documents
        (vlax-get-acad-object))(strcat dir i))
  )
)
[/php]

上述程序读取文件的方式跟我的一样。但我的可以通过对话框随意指定目录。
上述目前需要输入目录，且只能是根目录
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

721118231
发表于 2013-10-12 21:15:58 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
谢谢~~~~~~~~~~~~~~~~~~~~~~~~~~~·
- 本文出自晓东CAD家园-论坛，原文地址：http://bbs.xdcad.net/thread-670093-1-1.html
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

spp_wall

已领礼包: 127个

财富等级: 日进斗金
发表于 2013-10-13 10:30:56 | 显示全部楼层
看起来不错  适合规划？
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

杜流浪人

已领礼包: 720个

财富等级: 财运亨通
发表于 2014-2-23 17:00:07 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
支持了      强烈支持   
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

enn09
发表于 2014-4-16 15:24:40 | 显示全部楼层
感谢分享，支持了
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

fjb54007
发表于 2014-11-14 20:24:34 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
很有用 谢谢楼主分享
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

下一页 »
12下一页
返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2024-11-22 06:16 , Processed in 0.272681 second(s), 73 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

快速回复 返回顶部 返回列表