选择集按属性分堆（院长函数小改）
院长分享了一个函数，xyp-SsSort-Dxf 选择集依据dxf码值分类，很强大的一个函数，详见：http://bbs.mjtd.com/thread-100381-1-1.html
对这个函数做了一点点修改，其实就改了两三行，采用get属性的方式，对选择集进行分堆。
;; SsSort-sx 选择集依据dxf码值分类 (SsSort-sx ss keyname)
;; (SsSort-sx (ssget) "Length")，返回表，例如((201.617 (<图元名: -274ee8> <图元名: -274ed8> <图元名: -274ec8> <图元名: -274eb8> <图元名: -274ea8>)) (473.583 (<图元名: -274ef0> <图元名: -274ee0> <图元名: -274ed0> <图元名: -274ec0> <图元名: -274eb0>)))
(defun SsSort-sx (ss keyname / a b dx i lst lst-dxf lst-num s1 xyp-dxf)
(if (and ss (= (type ss) 'PICKSET) (> (sslength ss) 0))
(progn
(setq lst-dxf '()
i -1
)
(while (setq s1 (ssname ss (setq i (1+ i))))
(setq obj (vlax-ename->vla-object s1))
(setq dx ((eval (read (strcat "vla-get-" keyname))) obj)
lst-dxf (cons (list dx s1) lst-dxf)
)
)
(setq lst-dxf (vl-sort lst-dxf '(lambda (x y) (< (car x) (car y))))
lst-num '()
a (car lst-dxf)
lst-dxf (cdr lst-dxf)
lst (list (cadr a))
)
(while (setq b (car lst-dxf))
(setq lst-dxf (cdr lst-dxf))
(if (= (type (car a)) 'REAL)
(if (equal (car a) (car b) 1e-5)
(setq lst (cons (cadr b) lst))
(setq lst-num (cons (list (car a) (reverse lst)) lst-num)
lst (list (cadr b))
a b
)
)
(if (equal (car a) (car b))
(setq lst (cons (cadr b) lst))
(setq lst-num (cons (list (car a) (reverse lst)) lst-num)
lst (list (cadr b))
a b
)
)
)
)
(reverse (cons (list (car a) (reverse lst)) lst-num))
)
)
)
一个简单的例子，拉伸单个桩。
举个实用的例子更好理解 http://bbs.mjtd.com/thread-190896-1-1.html
一个找朋友算法是通用算法，只需要改func函数就行 liuhe 发表于 2024-10-24 09:01
http://bbs.mjtd.com/thread-190896-1-1.html
一个找朋友算法是通用算法，只需要改func函数就行
谢谢流河大师，我学习下。 感谢分享...
页:
[1]