日志
多段线中提取节点坐标
热度 1 |
;;46.2 [功能] pline,lwpline点坐标表 By 无痕;;示例(vxs (car (entsel))),返回三维点坐标
(defun vxs (e / i v lst)
(setq i -1)
(while
(setq v (vlax-curve-getpointatparam e (setq i (1+ i))))
(setq lst (cons v lst))
)
(reverse lst)
)
;;;----2015/6/1--修改BY skg123---http://bbs.mjtd.com/home.php?mod=space&uid=334888---
(vl-load-com)
(terpri)
(If (= (Tblsearch "layer" "编号") nil)
(Command "layer" "m" "编号" "c" 7 "编号" "")
)
(setq th 1.0) ;字体高度
(Command "-style" "编号" "仿宋_GB2312" "" th "" "n" "n")
(prompt "\n批量提取多段线（pline,lwpline）坐标,加载命令:tqzb。")
(defun C:tqzb ()
(setq xuanze (getreal"\n 1.图面标注编号(txt)；2.图面不标注编号(txt)；3.输出为全站仪格式数据(dat)；4.输出为数学坐标(txt)；5.退出<1>："))
(if (= xuanze nil)(tqzb1))
(if (= xuanze 1 )(tqzb1))
(if (= xuanze 2 ) (tqzb2))
(if (= xuanze 3 ) (tqzb3))
(if (= xuanze 4 ) (tqzb4))
(if (= xuanze 5 )(close ff)(princ"已经退出！"))
)
;;;-----图面绘制编号--输出为测量坐标系------------
(defun tqzb1 (/ ss en ii ptb no pz)
(vl-load-com)
(setq cm (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq wjm (getfiled "请指定要保存的坐标文件" "e:\\" "txt" 1))
(setq fff (open wjm "w"))
(setq ss (ssget '((0 . "lwPOLYLINE"))))
(setq ii 0
no 0
)
(repeat (sslength ss)
(setq en (ssname ss ii)
ii (1+ ii)
ptb (vxs en)
pz (cdr (assoc 38 (entget en)))
)
(foreach pt ptb
(setq no (1+ no))
(command "text" "j" "bl" pt th "0" (strcat (rtos no 2 0)) "");图面绘制编号
(write-line
(strcat
(itoa no) ","
(rtos (cadr pt) 2 3)
","
(rtos (car pt) 2 3)
","
(rtos pz 2 3)
)
fff
)
)
(write-line "" fff)
)
(close fff)
(princ (strcat "\n输出为测量坐标系坐标，已存入\"" wjm "\"中"))
(setvar "cmdecho" cm)
(princ)
)
;;;-----图面不绘制编号--输出为测量坐标系------------
(defun tqzb2 (/ ss en ii ptb no pz)
(vl-load-com)
(setq cm (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq wjm (getfiled "请指定要保存的坐标文件" "e:\\" "txt" 1))
(setq fff (open wjm "w"))
(setq ss (ssget '((0 . "lwPOLYLINE"))))
(setq ii 0
no 0
)
(repeat (sslength ss)
(setq en (ssname ss ii)
ii (1+ ii)
ptb (vxs en)
pz (cdr (assoc 38 (entget en)))
)
(foreach pt ptb
(setq no (1+ no))
; (command "text" "j" "bl" pt th "0" (strcat (rtos no 2 0)) "");图面绘制编号
(write-line
(strcat
(itoa no) ","
(rtos (cadr pt) 2 3)
","
(rtos (car pt) 2 3)
","
(rtos pz 2 3)
)
fff
)
)
(write-line "" fff)
)
(close fff)
(princ (strcat "\n输出为测量坐标系坐标，已存入\"" wjm "\"中"))
(setvar "cmdecho" cm)
(princ)
)
;;;-----图面不绘制编号--输出为测量坐标系------------
(defun tqzb3 (/ ss en ii ptb no pz)
(vl-load-com)
(setq cm (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq wjm (getfiled "请指定要保存的坐标文件" "e:\\" "dat" 1))
(setq fff (open wjm "w"))
(setq ss (ssget '((0 . "lwPOLYLINE"))))
(setq ii 0
no 0
)
(repeat (sslength ss)
(setq en (ssname ss ii)
ii (1+ ii)
ptb (vxs en)
pz (cdr (assoc 38 (entget en)))
)
(foreach pt ptb
(setq no (1+ no))
; (command "text" "j" "bl" pt th "0" (strcat (rtos no 2 0)) "");图面绘制编号
(write-line
(strcat
(itoa no) ",,"
(rtos (cadr pt) 2 3)
","
(rtos (car pt) 2 3)
","
(rtos pz 2 3)
)
fff
)
)
(write-line "" fff)
)
(close fff)
(princ (strcat "\n输出为测量坐标系坐标，已存入\"" wjm "\"中"))
(setvar "cmdecho" cm)
(princ)
)
;;;-----图面绘制编号--输出为数学坐标系------------
(defun tqzb4 (/ ss en ii ptb no pz)
(vl-load-com)
(setq cm (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq wjm (getfiled "请指定要保存的坐标文件" "e:\\" "txt" 1))
(setq fff (open wjm "w"))
(setq ss (ssget '((0 . "lwPOLYLINE"))))
(setq ii 0
no 0
)
(repeat (sslength ss)
(setq en (ssname ss ii)
ii (1+ ii)
ptb (vxs en)
pz (cdr (assoc 38 (entget en)))
)
(foreach pt ptb
(setq no (1+ no))
(command "text" "j" "bl" pt th "0" (strcat (rtos no 2 0)) "");图面绘制编号
(write-line
(strcat
(itoa no) ","
(rtos (car pt) 2 3)
","
(rtos (cadr pt) 2 3)
","
(rtos pz 2 3)
)
fff
)
)
(write-line "" fff)
)
(close fff)
(princ (strcat "\n输出为数学坐标系坐标，已存入\"" wjm "\"中"))
(setvar "cmdecho" cm)
(princ)
)
