[下载]：[下载]：可在多义线的角点上自动进行编号(功能：可自已选择起点、正向、反向

xxming

自已觉得还比较实用，大家试试

xyp1964

多义线顶点序号及坐标标注，可输出坐标数据到文本文件。
[php]
(load "xyp_lib");加载通用函数
;|
如果已经下载xyp_lib并放到搜索路径下可以不再下载!
利用以下任何一种方式即可加载和运行通用函数内的所有子程序：
1.在acad.lsp中增加(load"xyp_lib")
2.在每个程序内增加(load"xyp_lib")
3.在command下，输入(load"xyp_lib")
4.在菜单.mnl中增加(load"xyp_lib")
通用函数下载地址：http://www.xdcad.net/forum/showthread.php?s=&threadid=325268
|;
;;--------------------------------------------
;|
;;;功能 : 多义线顶点序号及坐标标注，可输出坐标数据到文本文件。
适用于 POLYLINE 及 LWPOLYLINE 图元 <lmf97231>
多义线编号--起始点随意选
在对管线（多义线）用LISP程序进行自动编号和座标计算时，有时需要编号顺时针递增，有时又需要编号逆时针递增，在选取多义线时，通过选取点来确定编号方向，也就是说当选取左半部分时从左往右开始，选取右半部分时从右往左开始。
2005.02.26 根据<xxming>的要求，修改标注闭合多义线存在的问题
2005.04.29 增加输出坐标数据到文本文件功能
|;
(defun c:test065 ()
  (cmdla0)
  (jzhz)
  (setq        tx1 (ukword 1 "1 2" "\n确定顶点顺序 : 1-正向/2-反向" tx1)
        tx2 (ukword 1 "Y N" "\n是否输出顶点坐标数据：Y-是/N-否" tx2)
  )
  (if (= tx2 "Y")
    (progn
      (setq ffn        (getfiled "\n保存的坐标文件" "坐标" "txt" 1)
            ff        (open ffn "w")
      )
    )
  )
  (command ".undo" "BE")
  (while (setq s1 (entsel "\n\t选择对象<退出> : "))
    (if        (or (= (dxf 0 (entget (car s1))) "POLYLINE")
            (= (dxf 0 (entget (car s1))) "LWPOLYLINE")
        )
      (progn
        (setq eobj (vlax-ename->vla-object (car s1))
              i           -1
        )
        (if (= tx1 "1")                        ;正向
          (progn
            (while
              (setq
                pt0 (vlax-curve-getPointAtParam eobj (setq i (1+ i)))
              )
               (princ)
            )
            (if        (= (dxf 70 (entget (car s1))) 1)
              (setq n (- i 1))
              (setq n i)
            )
            (setq i -1)
            (repeat n
              (setq
                pt0 (vlax-curve-getPointAtParam eobj (setq i (1+ i)))
              )
              (mkla "坐标编号" 1)
              (command "text"
                       "j"
                       "mr"
                       (polar pt0 (* pi 0.75) (* sc 200))
                       (* sc 400)
                       "0"
                       (rtos (+ 1 i) 2 0)
              )
              (mkla "坐标" 3)
              (X_zb pt0)
              (if (= tx2 "Y")
                (wr-tx pt0 ff)
              )
            )
          )
          ;;反向
          (progn
            (while
              (setq
                pt0 (vlax-curve-getPointAtParam eobj (setq i (1+ i)))
              )
               (princ)
            )
            (if        (= (dxf 70 (entget (car s1))) 1)
              (setq n (- i 1))
              (setq n i)
            )
            (setq i -1)
            (repeat n
              (setq
                pt0 (vlax-curve-getPointAtParam eobj (setq i (1+ i)))
              )
              (mkla "坐标编号" 1)
              (command "text"
                       "j"
                       "mr"
                       (polar pt0 (* pi 0.75) (* sc 200))
                       (* sc 400)
                       "0"
                       (rtos n 2 0)
              )
              (setq n (1- n))
              (mkla "坐标" 3)
              (X_zb pt0)
              (if (= tx2 "Y")
                (wr-tx pt0 ff)
              )
            )
          )
        )
      )
    )
  )
  (if (= tx2 "Y")
    (progn
      (close ff)
      (princ (strcat "\n 坐标写至=>" ffn))
    )
  )
  (command ".undo" "E")
  (cmdla1)
)
;;;
(defun wr-tx (point filename / tx)
  (setq        tx (strcat (rtos (+ 1 i) 2 0)
                   ":"
                   (rtos (car point) 2)
                   ","
                   (rtos (cadr point) 2)
                   ","
                   (rtos (caddr point) 2)
           )
  )
  (write-line tx filename)
)[/php]

luob72

xyp1964  版主的程序很不错，可惜一次只能选一个物体，而且要是支持POINT的坐标提取就更完美了