;;;多段线坐标标注并导出
(defun c:zbbzdc()
(setq ps_cmdecho (getvar "cmdecho")
ps_osmode (getvar "osmode")
ps_luprec (getvar "luprec")
)
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(setvar "luprec" 0)
(setq TextHeight (getdist "\n请输入文字高度:"))
(command "-layer" "n" "坐标标注" "c" "4" "坐标标注" "")
(setvar"dimzin"0);;保留小数位数时如果位数不足可以补零
(princ "\n输入引线长度 (建议")(princ (* TextHeight 10))(princ ")")
(princ ":")
(setq long (getreal))
(setq sunmer (ssget '((-4 . "
(0 . "POLYLINE")
(0 . "LWPOLYLINE")
(-4 . "OR>")
)
)
)
(setq germeip (sslength sunmer))
(setq pianju (* TextHeight 0.1))
(setq somode 0)
(while (< somode germeip)
(setq limes (entget (ssname sunmer somode)))
(setq limun (length limes))
(setq aobel 0)
(while (< aobel limun)
(if (= (car (nth aobel limes)) 10)
(progn
(command "layer" "s" "坐标标注" "")
(setq pt (cdr (nth aobel limes)))
(setq pt1 (polar pt (+ 0 (* 0.4 pi)) long))
(setq pt2 (polar pt1 0 (* TextHeight 7.5)))
(command "line" pt pt1 pt2 "")
(setq xx (strcat "Y=" (rtos (car pt) 2 3)))
(setq yy (strcat "X=" (rtos (cadr pt) 2 3)))
(setq ptx (list (+ (car pt1) 0.1) (- (cadr pt1) TextHeight)))
(setq pty (list (+ (car pt1) 0.1) (+ (cadr pt1) pianju)))
(command "text" pty TextHeight 0 yy)
(command "text" ptx TextHeight 0 xx)
)
)
(setq aobel (1+ aobel))
)
(setq somode (1+ somode))
)
(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 sunmer i 0
filex (getfiled "指定输出文件路径" "" "xls" 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") (cons 1 (strcat (itoa (1+ i))"#线段")) (cons 10 (list (car p) (- (cadr p) TextHeight)))(cons 7 "宋体") (cons 40 TextHeight)))
(while (setq p (assoc 10 ent))
(setq ent (cdr (member p ent)) p (cdr p))
(entmake (list '(0 . "TEXT") (cons 1 (itoa j)) (cons 10 (list (+ (car p) 0.01) (- (cadr p) 0.01)))(cons 7 "宋体") (cons 40 TextHeight)(cons 8 "编号")(cons 62 3) ))
(write-line (strcat (itoa j) "\t" (rtos (cadr p) 2 3) "\t" (rtos (car p) 2 3) "\t"
(if (caddr p) (rtos (caddr p) 2 3)"0.0")) file )
(setq j (1+ j))
)
(setq i (1+ i))
)
(close file)
(princ)
)