选择集按属性分堆（院长函数小改）

hubeiwdlue

院长分享了一个函数，xyp-SsSort-Dxf 选择集依据dxf码值分类，很强大的一个函数，详见：

http://bbs.mjtd.com/thread-100381-1-1.html
对这个函数做了一点点修改，其实就改了两三行，采用get属性的方式，对选择集进行分堆。

2. ;; SsSort-sx 选择集依据dxf码值分类 (SsSort-sx ss keyname)
   
3. ;; (SsSort-sx (ssget) "Length")，返回表，例如((201.617 (<图元名: -274ee8> <图元名: -274ed8> <图元名: -274ec8> <图元名: -274eb8> <图元名: -274ea8>)) (473.583 (<图元名: -274ef0> <图元名: -274ee0> <图元名: -274ed0> <图元名: -274ec0> <图元名: -274eb0>)))
   
4. (defun SsSort-sx (ss keyname / a b dx i lst lst-dxf lst-num s1 xyp-dxf)
   
5.   (if (and ss (= (type ss) 'PICKSET) (> (sslength ss) 0))
   
6.     (progn
   
7.       (setq lst-dxf '()
   
8.         i -1
   
9.       )
   
10.       (while (setq s1 (ssname ss (setq i (1+ i))))
    
11.         (setq obj (vlax-ename->vla-object s1))
    
12.          (setq dx ((eval (read (strcat "vla-get-" keyname))) obj)
    
13.            lst-dxf (cons (list dx s1) lst-dxf)
    
14.          )
    
15.       )
    
16.       (setq lst-dxf (vl-sort lst-dxf '(lambda (x y) (< (car x) (car y))))
    
17.         lst-num '()
    
18.         a            (car lst-dxf)
    
19.         lst-dxf (cdr lst-dxf)
    
20.         lst            (list (cadr a))
    
21.       )
    
22.       (while (setq b (car lst-dxf))
    
23.         (setq lst-dxf (cdr lst-dxf))
    
24.         (if (= (type (car a)) 'REAL)
    
25.           (if (equal (car a) (car b) 1e-5)
    
26.             (setq lst (cons (cadr b) lst))
    
27.             (setq lst-num (cons (list (car a) (reverse lst)) lst-num)
    
28.               lst          (list (cadr b))
    
29.               a          b
    
30.             )
    
31.           )
    
32.           (if (equal (car a) (car b))
    
33.             (setq lst (cons (cadr b) lst))
    
34.             (setq lst-num (cons (list (car a) (reverse lst)) lst-num)
    
35.               lst          (list (cadr b))
    
36.               a          b
    
37.             )
    
38.           )
    
39.         )
    
40.       )
    
41.       (reverse (cons (list (car a) (reverse lst)) lst-num))
    
42.     )
    
43.   )
    
44. )

;; SsSort-sx 选择集依据dxf码值分类 (SsSort-sx ss keyname)<br /> ;; (SsSort-sx (ssget) "Length")，返回表，例如((201.617 (<图元名: -274ee8> <图元名: -274ed8> <图元名: -274ec8> <图元名: -274eb8> <图元名: -274ea8>)) (473.583 (<图元名: -274ef0> <图元名: -274ee0> <图元名: -274ed0> <图元名: -274ec0> <图元名: -274eb0>)))<br /> (defun SsSort-sx (ss keyname / a b dx i lst lst-dxf lst-num s1 xyp-dxf)<br />   (if (and ss (= (type ss) 'PICKSET) (> (sslength ss) 0))<br />     (progn<br />       (setq lst-dxf '()<br />         i -1<br />       )<br />       (while (setq s1 (ssname ss (setq i (1+ i))))<br />         (setq obj (vlax-ename->vla-object s1))<br />          (setq dx ((eval (read (strcat "vla-get-" keyname))) obj)<br />            lst-dxf (cons (list dx s1) lst-dxf)<br />          )<br />       )<br />       (setq lst-dxf (vl-sort lst-dxf '(lambda (x y) (< (car x) (car y))))<br />         lst-num '()<br />         a            (car lst-dxf)<br />         lst-dxf (cdr lst-dxf)<br />         lst            (list (cadr a))<br />       )<br />       (while (setq b (car lst-dxf))<br />         (setq lst-dxf (cdr lst-dxf))<br />         (if (= (type (car a)) 'REAL)<br />           (if (equal (car a) (car b) 1e-5)<br />             (setq lst (cons (cadr b) lst))<br />             (setq lst-num (cons (list (car a) (reverse lst)) lst-num)<br />               lst          (list (cadr b))<br />               a          b<br />             )<br />           )<br />           (if (equal (car a) (car b))<br />             (setq lst (cons (cadr b) lst))<br />             (setq lst-num (cons (list (car a) (reverse lst)) lst-num)<br />               lst          (list (cadr b))<br />               a          b<br />             )<br />           )<br />         )<br />       )<br />       (reverse (cons (list (car a) (reverse lst)) lst-num))<br />     )<br />   )<br /> )

hubeiwdlue

一个简单的例子，拉伸单个桩。

bai2000

举个实用的例子更好理解

liuhe

http://bbs.mjtd.com/thread-190896-1-1.html

一个找朋友算法是通用算法，只需要改func函数就行

hubeiwdlue

liuhe 发表于 2024-10-24 09:01
http://bbs.mjtd.com/thread-190896-1-1.html

一个找朋友算法是通用算法，只需要改func函数就行

谢谢流河大师，我学习下。

muai2010

感谢分享...