[分享]：【实用程序汇总】test000系列！

mytsingtao

太好了
强人!!!!
支持!!!

xlf25

看上去很好!可是我用的是R14啊!

赶快升级吧！by xyp1964[/COLOR]

xiongxiaoke

很好啊

Create Idea

搞了半天,把路径搞清楚了才加载成功.

wjy10319

2002下能不能用啊？

kfd216

支持，支持，楼主真是太好了，应该给他多加点分

JH9981

斑竹你好,我用menu加载了你的菜单文件MNL、MNS后， 怎么出现CAD中自带的全部菜单一个都不见了，请问怎样将CAD中自带的全部菜单也恢复过来。

“吃了碗里的还看到锅里的！”
正常情况下不可能同时加载两个菜单文件。
恢复cad菜单同样可以用menu加载。
简化命令：
(defun c:test000()(command"menu""test000"))
(defun c:acad()(command"menu""acad"))
[I]By xyp1964[/I][/COLOR]

knight1024

好多啊,,,眼睛都看花了

可以先使用带★号的！[I]By xyp1964[/I][/COLOR]

yuantom

加载不了的?

无米之炊！不下载如何加载？！by xyp1964[/COLOR]

zbweixkj

xyp1964大师，test61坐标写到文件，功能是挺好用的。不过，有时我想提取三维多义线的坐标点数据，并写到文件里。对三维坐标的提取能实现吗，在这先谢谢你了，你的东西实在是太好了。

见楼下程序，改用程序“test065”。by xyp1964[/COLOR]

xyp1964

[php]
;;-----------------------------------------------------------------------------
;|
;;;功能 : 多义线顶点序号及坐标标注，可输出坐标数据到文本文件。
适用于 POLYLINE 及 LWPOLYLINE 图元 <lmf97231>
多义线编号--起始点随意选
在对管线（多义线）用LISP程序进行自动编号和座标计算时，有时需要编号顺时针递增，
有时又需要编号逆时针递增，在选取多义线时，通过选取点来确定编号方向，也就是说当
选取左半部分时从左往右开始，选取右半部分时从右往左开始。
2005.02.26 根据<xxming>的要求，修改标注闭合多义线存在的问题
2005.04.29 增加输出坐标数据到文本文件功能
|;
(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
|;

(defun c:test065 ()
  (cmdla0)
  (setbl)
  (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]

ysx810210

楼主的程序真的太棒了，佩服！！！将继续程序的升级。真心的说声：谢谢，辛苦了

zbweixkj

xyp1964大师，我用您的test065程序，不知怎么回事，老是出现参数错误，而用test061则没这个问题，能帮助我再看一下吗，先谢了。

什么参数错误？ by xyp1964[/COLOR]

wj518_0

谢谢，我觉得真的很实用,谢谢楼主啊

liuxg2005

建议那位高手对此程序进行深层次的交流，然后将改进或增加功能的新程序传给楼主，然后放到2楼供大家下载及学习