请帮忙写个LINE（pline)直线图元名表

434939575

请朋友们帮忙写个LINE（pline)直线，分别把相同长度的图元名做一个表，例如（（aa  .......)(bb......)(cc.......)...),谢谢。

csharp

(xd::list:groupbyindex (mapcar '(lambda (x) (list (xdrx_getpropertyvalue x "length") x))(xdrx_pickset->ents(ssget'((0 . "line,lwpolyline)))) 0.001)

434939575

csharp 发表于 2015-8-2 17:06
(xd::list:groupbyindex (mapcar '(lambda (x) (list (xdrx_getpropertyvalue x "length") x))(xdrx_pickse ...

感谢朋友的指导！没有通用函数就好了{:soso_e113:}

gufengyin

2. <p>;;; 2015年8月4日</p><p>(vl-load-com)
   
3. (defun c:tt (/ LST SS)
   
4.   (if (setq ss (ssget '((0 . "LINE,*POLYLINE"))))
   
5.     (progn
   
6.       (setq lst (tt ss))
   
7.       ;;_(setq lst (mapcar '(lambda (x) (cdr x)) lst));_删除表中第一项长度值
   
8.       )
   
9.     )
   
10.   (princ lst)
    
11.   (princ)
    
12.   )
    
13. ;;_同长度的组表
    
14. (defun tt (ss / EN I LEN LST SL)
    
15.   (setq lst '())
    
16.   (setq i -1)
    
17.   (while (setq en (ssname ss (setq i (1+ i))))
    
18.     (setq len (vla-get-Length (vlax-ename->vla-object en)))
    
19.     (if (setq sL (assoc len lst))
    
20.       (progn
    
21.         (setq lst (subst (append sL (list en)) sL lst))
    
22.         )
    
23.       (setq lst (cons (list len en) lst))
    
24.       )
    
25.     )
    
26.   )</p>

<p>;;; 2015年8月4日</p><p>(vl-load-com)<br /> (defun c:tt (/ LST SS)<br />   (if (setq ss (ssget '((0 . "LINE,*POLYLINE"))))<br />     (progn<br />       (setq lst (tt ss))<br />       ;;_(setq lst (mapcar '(lambda (x) (cdr x)) lst));_删除表中第一项长度值<br />       )<br />     )<br />   (princ lst)<br />   (princ)<br />   )<br /> ;;_同长度的组表<br /> (defun tt (ss / EN I LEN LST SL)<br />   (setq lst '())<br />   (setq i -1)<br />   (while (setq en (ssname ss (setq i (1+ i))))<br />     (setq len (vla-get-Length (vlax-ename->vla-object en)))<br />     (if (setq sL (assoc len lst))<br />       (progn<br />         (setq lst (subst (append sL (list en)) sL lst))<br />         )<br />       (setq lst (cons (list len en) lst))<br />       )<br />     )<br />   )</p>

yoyoho

感谢 gufengyin 分享程序!

434939575

gufengyin 发表于 2015-8-4 00:26

谢谢你的帮助！