[急求]自动识别两个半圆及自动缩放

张和平

如上图，我现在有大量的这种东西要进行缩放，但不是块，圆也是两个半圆拼起来的。
我的要求是：
1、能够批量进行；
2、能够识别两个半圆拼起来的这个圆，并对这个圆以及其内部的内容进行缩放，缩放基点是这个原因的圆心；
3、要求对每个这样的元素分别缩放；
4、缩放系数先定为2，如果你能提供lsp文件的画我自己来改也行。
急用急用。大神们出手帮帮忙。

ll_j

看这样子好像是打散的圆环（dount），急用就请到我的网络U盘去下载一个CDN.lsp试试，不保证成功，但可以一试，在家里，手上东西不全，程序就不写了。

操作步骤：
先用PEdit的M模式把这些半圆连接成整的多义线（Pe－y－j－c），然后使用cdn.lsp。

张和平

ll_j 发表于 2013-3-24 19:50
看这样子好像是打散的圆环（dount），急用就请到我的网络U盘去下载一个CDN.lsp试试，不保证成功，但可以一试 ...

额。。。这样的话有点慢了。。我一个个sc也可以了。。。啊哦

yjr111

试试我的组合物体选择

张和平

yjr111 发表于 2013-3-24 22:03
试试我的组合物体选择

?????长老，具体呢？

张和平

yjr111 发表于 2013-3-24 22:03
试试我的组合物体选择

找到了您的组合物体选择，但是：1、不能同时选择圆内的元素，2、不能选择缩放基点

张和平

yjr111 发表于 2013-3-24 22:03
试试我的组合物体选择

不过能很大程度上提高我的效率，，非常感谢

张和平

yjr111 发表于 2013-3-24 22:03
试试我的组合物体选择

找到过您发布源码的那个帖子，但是好像已经找不到下载的地方了么

zml84

1. ;;;问题来源：http://bbs.mjtd.com/forum.php?mod=viewthread&tid=100648;;;功能：两对扣半圆识别
   
2. ;;;日期：zml84 于 2013-04-30
   
3. (defun c:tt ()
   
4.   ;;1 提取圆弧信息
   
5.   (setq        lst '()
   
6.         i   0
   
7.   )
   
8.   (if (setq ss (ssget '((0 . "ARC"))))
   
9.     (repeat (sslength ss)
   
10.       (setq en        (ssname ss i)
    
11.             ent        (entget en)
    
12.       )
    
13.       (setq pt        (cdr (assoc 10 ent))
    
14.             r        (cdr (assoc 40 ent))
    
15.             lst        (cons (list pt r en) lst)
    
16.       )
    
17.       (setq i (1+ i))
    
18.     )
    
19.   )
    
20.   ;;(princ lst)
    
21. 
    
22.   ;;2 成对匹配
    
23.   (setq lst2 '())
    
24.   (while lst
    
25.     (setq lst_new '()
    
26.           tmp (car lst)
    
27.     )
    
28.     (foreach x (cdr lst)
    
29.       (if (and (equal (car x) (car tmp) 1e-4)
    
30.                (equal (cadr x) (cadr tmp) 1e-4)
    
31.           )
    
32.         (setq tmp (append tmp (cddr x)))
    
33.         (setq lst_new (cons x lst_new))
    
34.       )
    
35.     )
    
36.     (setq lst2 (cons tmp lst2)
    
37.           lst  lst_new
    
38.     )
    
39.   )
    
40.   ;;(princ lst2)
    
41. 
    
42.   ;;3 缩放操作
    
43.   (command "_.undo" "be")
    
44.   (foreach tmp lst2
    
45.     (setq pt (car tmp)
    
46.           r  (cadr tmp)
    
47.     )
    
48.     (setq pt  (trans pt 0 1)
    
49.           pt1 (polar pt (* 0.25 pi) r)
    
50.           pt2 (polar pt (* 1.25 pi) r)
    
51.     )
    
52.     (if        (setq ss (ssget "c" pt1 pt2 '((0 . "text"))))
    
53.       (progn
    
54.         (foreach en (cddr tmp)
    
55.           (ssadd en ss)
    
56.         )
    
57.         (command "SCALE" ss "" "non" pt 2)
    
58.       )
    
59.     )
    
60.   )
    
61.   (command "_.undo" "e")
    
62. 
    
63.   ;;
    
64.   (princ)
    
65. )

;;;问题来源：<a href="http://bbs.mjtd.com/thread-100648-1-1.html" target="_blank">http://bbs.mjtd.com/forum.php?mod=viewthread&tid=100648</a>;;;功能：两对扣半圆识别<br /> ;;;日期：zml84 于 2013-04-30<br /> (defun c:tt ()<br />   ;;1 提取圆弧信息<br />   (setq        lst '()<br />         i   0<br />   )<br />   (if (setq ss (ssget '((0 . "ARC"))))<br />     (repeat (sslength ss)<br />       (setq en        (ssname ss i)<br />             ent        (entget en)<br />       )<br />       (setq pt        (cdr (assoc 10 ent))<br />             r        (cdr (assoc 40 ent))<br />             lst        (cons (list pt r en) lst)<br />       )<br />       (setq i (1+ i))<br />     )<br />   )<br />   ;;(princ lst)<br /> <br />   ;;2 成对匹配<br />   (setq lst2 '())<br />   (while lst<br />     (setq lst_new '()<br />           tmp (car lst)<br />     )<br />     (foreach x (cdr lst)<br />       (if (and (equal (car x) (car tmp) 1e-4)<br />                (equal (cadr x) (cadr tmp) 1e-4)<br />           )<br />         (setq tmp (append tmp (cddr x)))<br />         (setq lst_new (cons x lst_new))<br />       )<br />     )<br />     (setq lst2 (cons tmp lst2)<br />           lst  lst_new<br />     )<br />   )<br />   ;;(princ lst2)<br /> <br />   ;;3 缩放操作<br />   (command "_.undo" "be")<br />   (foreach tmp lst2<br />     (setq pt (car tmp)<br />           r  (cadr tmp)<br />     )<br />     (setq pt  (trans pt 0 1)<br />           pt1 (polar pt (* 0.25 pi) r)<br />           pt2 (polar pt (* 1.25 pi) r)<br />     )<br />     (if        (setq ss (ssget "c" pt1 pt2 '((0 . "text"))))<br />       (progn<br />         (foreach en (cddr tmp)<br />           (ssadd en ss)<br />         )<br />         (command "SCALE" ss "" "non" pt 2)<br />       )<br />     )<br />   )<br />   (command "_.undo" "e")<br /> <br />   ;;<br />   (princ)<br /> )

张和平

zml84 发表于 2013-4-30 14:25

感谢回复。但是我试了一下，貌似不能缩放呢，，不知是何原因。。。