批量多段线坐标标注 编号 导出

gaomingabc456

(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)
)

60ck

谢谢楼主的分享！满好用的…也很实用

yjf247606

辛苦楼主，感谢！

teacoffee

挺不错的。赞！

小康_U8y3Y

能不能搞一个批量标注XYZ的程序

kmliro_2017

不错，谢谢分享！！！！！

tangzengbin

这个功能非常实用，感谢楼主分享

wyy81061

收藏，谢谢分享