多段线各端点批量标注坐标并编号然后把各点坐标导出到文本上
本帖最后由 88641787 于 2015-12-30 11:12 编辑多段线各端点标注坐标并编号然后把各点坐标导出到文本上
本帖最后由 香田里浪人 于 2015-12-30 18:40 编辑
;;;多段线坐标标注并导出
(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 "<上次长度为")(princ long)(princ ">:")
(setq long (getreal))
(setq sunmer (ssget '((-4 . "<OR")
(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 sunmeri 0
filex (getfiled "指定输出文件路径" "" "xls" 1) file (open filex "w"))
(repeat (sslength ss)
(setq j 1ent (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)
)
一个求助帖，标题怎么写[源码]？
标注坐标引线都是一个方向，楼主的标注都向“外” zzyong00 发表于 2015-12-29 20:05 static/image/common/back.gif
标注坐标引线都是一个方向，楼主的标注都向“外”
一个在左一个在右 要不就是一个在上一个在下 香田里浪人 发表于 2015-12-29 21:13 static/image/common/back.gif
;;;多段线坐标标注并导出
(defun c:zbbzbdc()
(setq ps_cmdecho (getvar "cmdecho")
你好版主 这个只是标注坐标 没有标注序号 也没有把坐标导出至记事本里 88641787 发表于 2015-12-29 21:44 static/image/common/back.gif
一个在左一个在右 要不就是一个在上一个在下
其实图片上那种效果已经很好了 本帖最后由 香田里浪人 于 2015-12-30 18:42 编辑
88641787 发表于 2015-12-29 21:46 http://bbs.mjtd.com/static/image/common/back.gif
你好版主 这个只是标注坐标 没有标注序号 也没有把坐标导出至记事本里
我不是版主，88641787先生，五楼程序已经修改，这下应该可以用了 5楼程序可以满足楼主要求。