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

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

寒潮大冬瓜

土土木木人 发表于 2024-6-18 08:34
优化了一下，XY可以颠倒

『建桥工具箱』提示您，请输入文字高度<3>：33

『建桥工具箱』提示您，请选择多段线：
『建桥工具箱』出现 [类型不正确 - (<ENTITY NAME: 50fcb6c8> (2.32505e+06 -936965.0 0.0))] 错误！

muai2010

土土木木人 发表于 2024-6-19 11:02
出错的时候，用(PRINC XX)读取下XX变量的值

可以用，还不错，演示图

如果能像下面这样显示就是完美了

土土木木人

p-3-ianlcc 发表于 2024-6-19 09:54
我是用空白的文档，自己随便画几条线进行测试
没有特别用什麽文档测试

出错的时候，用(PRINC XX)读取下XX变量的值

bai2000

不错，能指定坐标原点更好，也更实用

寒潮大冬瓜

很好→很棒！很好~很棒！！很好……很棒！！！建议优化兼容：二维多段线、三维多段线等

土土木木人

优化了一下，XY可以颠倒

寒潮大冬瓜

支持！很好→很棒！很好~很棒！！很好……很棒！！！期待继续优化！

p-3-ianlcc

土土木木人 发表于 2024-6-18 08:34
优化了一下，XY可以颠倒

我有测试了一下，会出现消息

土土木木人

p-3-ianlcc 发表于 2024-6-18 18:14
我有测试了一下，会出现消息

没遇到过，是啥版本的CAD，2024都测试可以的

p-3-ianlcc

土土木木人 发表于 2024-6-18 22:04
没遇到过，是啥版本的CAD，2024都测试可以的

我是在2024上使用的
出现这个讯息，而且不只一次…约四、五次之多

bai2000

能不能指定坐标的原点？

土土木木人

bai2000 发表于 2024-6-19 06:54
能不能指定坐标的原点？

可以