批量多段线坐标标注 编号 导出
(defun c:getplpt();;批量多段线坐标标注编号导出
(setq ps_cmdecho (getvar "cmdecho");;获取图层
ps_osmode(getvar "osmode") ;;获取捕捉
ps_luprec(getvar "luprec") ;;设定线性单位和坐标的显示精度。
)
(setvar "cmdecho" 0)
(setvar "osmode"0)
(setvar "luprec"0)
(setvar "dimzin"1);;控制针对主单位值的消零处理。
(setvar "pdmode" 35) ;;点样式
(setvar "pdsize" 0.3) ;;点大小
(command "-units" "2" "4" "2" "3" "" "");;;控制坐标、距离和角度的精度和显示格式。
(setq TextHeight (getdist "\n 请输入文字高度:"))
(if (null TextHeight)(setq TextHeight 0.5))
(setq chhlay (tblsearch "layer" "多段线坐标标注"))
(if (null chhlay)(command "-layer" "m" "多段线坐标标注" "c" "3" "多段线坐标标注" ""))
(princ "\n 输入引线长度 (建议")
(princ (* TextHeight 2))
(princ ")")
(princ ":")
(setq long (getreal))
(if (null long)(setq long (* TextHeight 2)))
(setq plss (ssget '((-4 . "<or")(0 . "POLYLINE")(0 . "LWPOLYLINE")(-4 . "OR>") )))
(setq sn (sslength plss))
(setq pianju (* TextHeight 0.2))
(setq num 0)
(while (< num sn)
(setq ept (entget (ssname plss num)))
(setq plnum (length ept))
(setq num1 0)
(while (< num1 plnum)
(if (= (car (nth num1 ept)) 10)
(progn
(command "layer" "s" "多段线坐标标注" "")
(setq pt(cdr (nth num1 ept)))
(setq pt1 (polar pt (+ 0 (* 0.4 pi)) long))
(setq pt2 (polar pt1 0 (* TextHeight 10)))
(command "line" pt pt1 pt2 "") ;;引线
(setq xx (strcat "Y=" (rtos (car pt) 2 4)))
(setq yy (strcat "X=" (rtos (cadr pt) 2 4)))
(setq ptx (list (+ (car pt1) 0.2) (- (- (cadr pt1) TextHeight) pianju)))
(setq pty (list (+ (car pt1) 0.2) (+ (cadr pt1) pianju)))
(command "text" pty TextHeight 0 yy)
(command "text" ptx TextHeight 0 xx)
)
)
(setq num1 (1+ num1))
)
(setq num (1+ num))
)
(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)
)
(setq ss plss
i 0
filex (getfiled "输出文件" "d:/多线段导出坐标文件" "xls;txt;dat;csv" 1)
file(open filex "w")
)
(repeat (sslength ss)
(setq j 1
ent (entget (ssname ss i))
p (cdr (assoc 10 ent))
)
(write-line (strcat "多段线" (itoa (1+ i))" #") file)
(write-line "点号\tX\tY\tZ" file)
(entmake
(list'(0 . "TEXT")
'(100 . "AcDbEntity")
'(100 . "AcDbText")
'(62 . 6) ;;颜色
'(40 . 0.6) ;;字高
(cons 7"仿宋") ;;字体
(cons 8"多段线数量编号") ;;图层
(cons 1(strcat (itoa (1+ i)) "#多段线")) ;;文字
(cons 10 (list (car p) (- (cadr p) TextHeight)));;位置
)
)
(while (setq p (assoc 10 ent))
(setq ent (cdr (member p ent)) p (cdr p))
(entmake
(list'(0 . "TEXT")
'(100 . "AcDbEntity")
'(100 . "AcDbText")
'(62 . 7)
'(40 . 0.6)
(cons 7"黑体")
(cons 8"多段线节点编号")
(cons 1(itoa j))
(cons 10 (list (+ (car p) 0.01) (- (cadr p) 0.01)))
)
)
(entmake (list '(0 . "POINT") '(62 . 1)(cons 8"点号") (cons 10 p) ));多段线上绘制点
(write-line(strcat (itoa j) "\t" (rtos (cadr p) 2 4) "\t" (rtos (car p) 2 4) "\t" (if (caddr p)(rtos (caddr p) 2 4) "0.000"))
file
)
(setq j (1+ j))
)
(setq i (1+ i))
)
(close file)
(startapp "notepad.exe" filex)
(setvar "CLAYER" "0")
(setvar "cmdecho" ps_cmdecho)
(setvar "osmode"ps_osmode)
(setvar "luprec"ps_luprec)
(princ"\n 批量多段线坐标标注、节点编号、坐标导出完成！谢谢使用！！！")
(prin1)
)
谢谢楼主的分享！满好用的…也很实用 辛苦楼主，感谢！ 挺不错的。赞！ 能不能搞一个批量标注XYZ的程序
页:
[1]