- UID
- 675105
- 积分
- 475
- 精华
- 贡献
-
- 威望
-
- 活跃度
-
- D豆
-
- 在线时间
- 小时
- 注册时间
- 2013-4-17
- 最后登录
- 1970-1-1
|
马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。
您需要 登录 才可以下载或查看,没有账号?立即注册
×
本帖最后由 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表长时有没有什么好的处理办法
 - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;批量导点绘图程序 版本号v1.01;;;;;;;;;;;;;;;;;;;;;;;;;
- ;| 需要完善的内容
- 1.提出宗地号,用地面积和项目名称
- 2.在图上标注宗地号、用地面积和项目名称
- 3.需要建立图层、设立字体和字体大小、字体颜色
- 作者 张亚军 邮箱gtj116600@163.com QQ 1085566757 编制日期 2013年7月15日 |;
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;批量整理TXT文本程序;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- (defun zyj-silenceexit( / *error*)
- (t (setq *error* strcat))
- )
- (defun c:pldraw( / Vcmdecho Vosmode ffn ph fn i n n1 fn1 fn2 fn3 lst
- str int len pt fn4 fn5 strlef strrig pos j datalist)
- (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) lst '())
- (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)
- )
- (defun txtinlist(ffname / datalist pt) ;;;将TXT文本文件导出整理成表
- (setq pt (read-line ffname) datalist '())
- (or pt (zyj-silenceexit))
- (while pt
- (setq datalist (cons pt datalist))
- (setq pt (read-line ffname))
- )
- (setq datalist (reverse datalist))
- )
- (setq i -1)
- (repeat n
- (setq fn4 (nth (setq i (1+ i)) lst))
- (setq fn5 (open fn4 "r"))
- (setq datalist (txtinlist fn5) j -1)
- ; (setq pt (read-line fn5) j -1)
- (command "pline")
- (while (setq pt (nth (setq j (1+ j)) datalist))
- (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批量导点绘图程序已加载成功,请在命令行输入pldraw命令唤醒她!!!")
|
|