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

hnxyj1

ddddddddddddddddd

namecool

程序太好了 谢谢楼主了 不知道能不能用在2008啊

xiaxiang

各函数需要的参数没有说明

stillsingle

好东西，怎么不能下载

听鱼

这个内容不错,比较丰富

xyp1964

[php];;; 实体面积反应器
(Defun C:test579 ()
  (Defun Rtest (obj1 obj2 lst)
    (xyp-SUBUPD        (HandEnt (VLR-Data obj2))
                1
                (RtoS (VLA-Get-Area obj1) 2 2)
    )
  )
  (cmdla0)
  (SetQ        s1  (Car (EntSel "\n请选择封闭实体: "))
        obj (vlax-ename->vla-object s1)
  )
  (xyp-Text 5
            (xyp-get-MinMaxPoint s1 5)
            (RtoS (VLA-Get-Area obj) 2 2)
  )
  (VLR-Object-Reactor
    (List obj)
    (xyp-get-dxf 5 (EntLast))
    '((:vlr-modified . Rtest))
  )
  (cmdla1)
)[/php]

wzh1234

谢谢LZ   无私奉献

homoyo

下不起

gwpgc

无私奉献和为大家服务的精神值得表扬和学习。

seekerlu

顶楼主，现在还不够爱心币

sunchi7749

感谢楼主分享！

zzq191

ghood!!!!!!!!!!!!!!!!!!!!!!!!!!!

hewenhua080518

真的是好东西呢  下个来看看

xyp1964

2. 
   
3. ;; 方框排版
   
4. (defun c:test1279 (/ i ss s1 pt)
   
5.   (CMDLA0)
   
6.   (princ "\n选择方框: ")
   
7.   (if (and (setq ss (ssget '((0 . "*polyLINE"))))
   
8.            (setq p0 (getpoint "\n基点<退出>: "))
   
9.       )
   
10.     (progn
    
11.       (setq i        -1
    
12.             lst        '()
    
13.       )
    
14.       (while (setq s1 (ssname ss (setq i (1+ i))))
    
15.         (setq dd  (distance (xyp-9pt s1 1) (xyp-9pt s1 7))
    
16.               lst (cons (list dd s1) lst)
    
17.         )
    
18.       )
    
19.       (setq lst        (vl-sort lst '(lambda (x y) (> (car x) (car y))))
    
20.             lst        (mapcar 'cadr lst)
    
21.       )
    
22.       (foreach a lst
    
23.         (princ)
    
24.         (xyp-move a (xyp-9pt a 1) p0)
    
25.         (setq p0 (xyp-Pt2X (xyp-9pt a 3) 300))
    
26.       )
    
27.     )
    
28.   )
    
29.   (CMDLA1)
    
30. )
    

<br /> ;; 方框排版<br /> (defun c:test1279 (/ i ss s1 pt)<br />   (CMDLA0)<br />   (princ "\n选择方框: ")<br />   (if (and (setq ss (ssget '((0 . "*polyLINE"))))<br />            (setq p0 (getpoint "\n基点<退出>: "))<br />       )<br />     (progn<br />       (setq i        -1<br />             lst        '()<br />       )<br />       (while (setq s1 (ssname ss (setq i (1+ i))))<br />         (setq dd  (distance (xyp-9pt s1 1) (xyp-9pt s1 7))<br />               lst (cons (list dd s1) lst)<br />         )<br />       )<br />       (setq lst        (vl-sort lst '(lambda (x y) (> (car x) (car y))))<br />             lst        (mapcar 'cadr lst)<br />       )<br />       (foreach a lst<br />         (princ)<br />         (xyp-move a (xyp-9pt a 1) p0)<br />         (setq p0 (xyp-Pt2X (xyp-9pt a 3) 300))<br />       )<br />     )<br />   )<br />   (CMDLA1)<br /> )<br />

xyp1964

2. 
   
3. ;; 图层备份
   
4. (defun c:test1280 ()
   
5.   (setq        lst  (xyp-Get-LayersColorLst)
   
6.         lst2 (mapcar '(lambda (x)
   
7.                         (strcat        (car x)
   
8.                                 " "
   
9.                                 (if (equal (type (setq a (cdr x))) 'INT)
   
10.                                   (itoa a)
    
11.                                   a
    
12.                                 )
    
13.                         )
    
14.                       )
    
15.                      lst
    
16.              )
    
17.   )
    
18.   (xyp-List2File lst2 "图层备份" "txt")
    
19.   (princ)
    
20. )
    

<br /> ;; 图层备份<br /> (defun c:test1280 ()<br />   (setq        lst  (xyp-Get-LayersColorLst)<br />         lst2 (mapcar '(lambda (x)<br />                         (strcat        (car x)<br />                                 " "<br />                                 (if (equal (type (setq a (cdr x))) 'INT)<br />                                   (itoa a)<br />                                   a<br />                                 )<br />                         )<br />                       )<br />                      lst<br />              )<br />   )<br />   (xyp-List2File lst2 "图层备份" "txt")<br />   (princ)<br /> )<br />