关于同心圆的判断与筛选。请各位高手帮帮忙

qinleilei

当一个图面上有很多个直径9.0和直径14.0及其他直径的单个圆  还有很多直径为9.0  14.0 的同心圆及其他直径的同心圆，如何快速筛选出这些直径为9.0  14.0的同心圆，将他们放入一个选择集里面，而其他的单个圆或者直径不是9.0 14.0 的的同心圆 就直接忽视不选。这种lsp该怎么写。老大们帮忙看看下。只用判断xy的坐标，z轴不用管
本人做模具设计的，经常要选中指定大小的螺丝沉头孔，每次都是手动一个一个的选的，好累

lite

附件为我写的关于选取同心圆的程序，为方便使用，写成了函数。

sfzyr

zctao1966 发表于 2014-8-13 12:48
①先选择所有的圆
②获取圆的圆心，组成表1
③删除重复的圆心，组成新的圆心表2

这个源程序能否给一个我

琴剑江山_10184

(defun c:kk( / ss)
  (setq ss (ssget '((-4 . "<OR") (40 . 4.5) (40 . 7.0) (-4 . "OR>"))))
   (if ss
    (progn
      (sssetfirst nil ss)
    )
  );if
  );给我明经币

SunSpring

还有同心呢,你这是所有9和14的都会选中.

Andyhon

...螺丝沉头孔...

模具内这些常用的 图党 建议改用 图块
除非您不想搭程序的便车,久用之后会感受到滴
走过... 那冤枉路...
谨供参考

SunSpring

1. (defun c:cc (/ center entdata entname fentdata fradius gentdata gradius
   
2.          ptlist radiusmax radiusmin subentgrp
   
3.       )
   
4.   (defun vla-ssname (ss index)
   
5.     (vlax-ename->vla-object (ssname ss index))
   
6.   )
   
7.   (defun gpax:getboundingbox (entgrp / entname entpl entplx entply entpr
   
8.              entprx entpry n
   
9.            )
   
10.     (if (= (type entgrp) 'ename)
    
11.       (setq entgrp (ssadd entgrp))
    
12.     )
    
13.     (repeat (setq n (sslength entgrp))
    
14.       (setq entname (vla-ssname entgrp (setq n (1- n))))
    
15.       (vla-getboundingbox entname 'entpl 'entpr)
    
16.       (setq entplx (cons (vlax-safearray-get-element entpl 0) entplx)
    
17.       entply (cons (vlax-safearray-get-element entpl 1) entply)
    
18.       entprx (cons (vlax-safearray-get-element entpr 0) entprx)
    
19.       entpry (cons (vlax-safearray-get-element entpr 1) entpry)
    
20.       )
    
21.     )
    
22.     (list (trans (list (apply
    
23.        'min
    
24.        entplx
    
25.            ) (apply
    
26.          'min
    
27.          entply
    
28.        )
    
29.      ) 0 1
    
30.     ) (trans (list (apply
    
31.          'max
    
32.          entprx
    
33.        ) (apply
    
34.            'max
    
35.            entpry
    
36.          )
    
37.        ) 0 1
    
38.       )
    
39.     )
    
40.   )
    
41.   (defun ssdelentgrp (ss1 ss2 / n)
    
42.     (repeat (setq n (sslength ss1))
    
43.       (ssdel (ssname ss1 (setq n (1- n))) ss2)
    
44.     )
    
45.   )
    
46.   (if (setq entgrp (ssget '((0 . "CIRCLE"))))
    
47.     (progn
    
48.       (setq ptlist (gpax:getboundingbox entgrp))
    
49.       (setq dephole (ssadd))
    
50.       (while (ssname entgrp 0)
    
51.   (setq entname (ssname entgrp 0)
    
52.         entdata (entget entname)
    
53.         center (cdr (assoc 10 entdata))
    
54.   )
    
55.   (setq subentgrp (ssget "W" (car ptlist) (cadr ptlist) (list
    
56.                     (cons 10 center)
    
57.                     (cons 0 "CIRCLE")
    
58.                     )
    
59.       )
    
60.   )
    
61.   (if (= (sslength subentgrp) 2)
    
62.     (progn
    
63.       (setq fentdata (entget (ssname subentgrp 0)))
    
64.       (setq gentdata (entget (ssname subentgrp 1)))
    
65.       (setq fradius (cdr (assoc 40 fentdata)))
    
66.       (setq gradius (cdr (assoc 40 gentdata)))
    
67.       (setq radiusmin (min
    
68.             fradius
    
69.             gradius
    
70.           )
    
71.       )
    
72.       (setq radiusmax (max
    
73.             fradius
    
74.             gradius
    
75.           )
    
76.       )
    
77.       (if (and
    
78.       (= radiusmin 4.5)
    
79.       (= radiusmax 7.0)
    
80.     )
    
81.         (progn
    
82.     (ssadd (ssname subentgrp 0) dephole)
    
83.     (ssadd (ssname subentgrp 1) dephole)
    
84.         )
    
85.       )
    
86.     )
    
87.   )
    
88.   (ssdelentgrp subentgrp entgrp)
    
89.       )
    
90.     )
    
91.   )
    
92.   (sssetfirst nil dephole)
    
93. )

(defun c:cc (/ center entdata entname fentdata fradius gentdata gradius<br />          ptlist radiusmax radiusmin subentgrp<br />       )<br />   (defun vla-ssname (ss index)<br />     (vlax-ename->vla-object (ssname ss index))<br />   )<br />   (defun gpax:getboundingbox (entgrp / entname entpl entplx entply entpr<br />              entprx entpry n<br />            )<br />     (if (= (type entgrp) 'ename)<br />       (setq entgrp (ssadd entgrp))<br />     )<br />     (repeat (setq n (sslength entgrp))<br />       (setq entname (vla-ssname entgrp (setq n (1- n))))<br />       (vla-getboundingbox entname 'entpl 'entpr)<br />       (setq entplx (cons (vlax-safearray-get-element entpl 0) entplx)<br />       entply (cons (vlax-safearray-get-element entpl 1) entply)<br />       entprx (cons (vlax-safearray-get-element entpr 0) entprx)<br />       entpry (cons (vlax-safearray-get-element entpr 1) entpry)<br />       )<br />     )<br />     (list (trans (list (apply<br />        'min<br />        entplx<br />            ) (apply<br />          'min<br />          entply<br />        )<br />      ) 0 1<br />     ) (trans (list (apply<br />          'max<br />          entprx<br />        ) (apply<br />            'max<br />            entpry<br />          )<br />        ) 0 1<br />       )<br />     )<br />   )<br />   (defun ssdelentgrp (ss1 ss2 / n)<br />     (repeat (setq n (sslength ss1))<br />       (ssdel (ssname ss1 (setq n (1- n))) ss2)<br />     )<br />   )<br />   (if (setq entgrp (ssget '((0 . "CIRCLE"))))<br />     (progn<br />       (setq ptlist (gpax:getboundingbox entgrp))<br />       (setq dephole (ssadd))<br />       (while (ssname entgrp 0)<br />   (setq entname (ssname entgrp 0)<br />         entdata (entget entname)<br />         center (cdr (assoc 10 entdata))<br />   )<br />   (setq subentgrp (ssget "W" (car ptlist) (cadr ptlist) (list<br />                     (cons 10 center)<br />                     (cons 0 "CIRCLE")<br />                     )<br />       )<br />   )<br />   (if (= (sslength subentgrp) 2)<br />     (progn<br />       (setq fentdata (entget (ssname subentgrp 0)))<br />       (setq gentdata (entget (ssname subentgrp 1)))<br />       (setq fradius (cdr (assoc 40 fentdata)))<br />       (setq gradius (cdr (assoc 40 gentdata)))<br />       (setq radiusmin (min<br />             fradius<br />             gradius<br />           )<br />       )<br />       (setq radiusmax (max<br />             fradius<br />             gradius<br />           )<br />       )<br />       (if (and<br />       (= radiusmin 4.5)<br />       (= radiusmax 7.0)<br />     )<br />         (progn<br />     (ssadd (ssname subentgrp 0) dephole)<br />     (ssadd (ssname subentgrp 1) dephole)<br />         )<br />       )<br />     )<br />   )<br />   (ssdelentgrp subentgrp entgrp)<br />       )<br />     )<br />   )<br />   (sssetfirst nil dephole)<br /> )

可能有些复杂但是可以用.

已经更新.再试下.

qinleilei

SunSpring 发表于 2014-8-10 21:27
可能有些复杂但是可以用.

错误: no function definition: VLA-SSNAME
试了一下不行。哥们 帮帮忙看下是哪里出了状况。
顺便感谢你下午帮我搞的那个尺寸公差，很给力

qinleilei

Andyhon 发表于 2014-8-10 21:21
...螺丝沉头孔...

模具内这些常用的 图党 建议改用 图块

用图块不方便，也没有见过用图块的。我们这都是用全3D画的模具再到2D里面出图，标加工注解的，所以螺丝类是一个很反锁的工作量

SunSpring

1. (defun vla-ssname (ss index)
   
2.   (vlax-ename->vla-object (ssname ss index))
   
3. )

(defun vla-ssname (ss index)<br />   (vlax-ename->vla-object (ssname ss index))<br /> )

前生

qinleilei 发表于 2014-8-10 21:53
用图块不方便，也没有见过用图块的。我们这都是用全3D画的模具再到2D里面出图，标加工注解的，所以螺丝类 ...

其实，块的应用时很方便的，可以尝试。
3D转过来的图纸，很多事乱七八槽的。
如果，块用的话的话，是很愉快的事

feng582304

2. (defun feng:ss:cir:1 ( / ss li n tmp )
   
3.   (if (setq ss (ssget '((-4 . "<and") (0 . "CIRCLE") (-4 . "<or") (40 . 4.5) (40 . 7.0) (-4 . "or>") (-4 . "and>"))))
   
4.     (progn
   
5.       (repeat (setq n (sslength ss))
   
6.         (setq tmp (ssname ss (setq n (1- n)))
   
7.               li (cons (list tmp (cdr (assoc 10 (entget tmp)))) li))
   
8.         )
   
9.       (feng:ss:cir:3 (feng:ss:cir:2 li))
   
10.       )
    
11.     )
    
12.   )
    
13. (defun feng:ss:cir:2 ( li / tmp )
    
14.   (if (setq tmp (vl-remove-if '(LAMBDA (x) (<= (abs (apply '+ (MAPCAR '- (cadr (car li)) (cadr x)))) 1e-05)) li))
    
15.     (append (list (MAPCAR 'car (VL-REMOVE-IF-NOT '(LAMBDA (x) (<= (abs (apply '+ (MAPCAR '- (cadr (car li)) (cadr x)))) 1e-05)) li))) (feng:ss:cir:2 tmp))
    
16.     (list (MAPCAR 'car li))
    
17.     )
    
18.   )
    
19. (defun feng:ss:cir:3 ( li / ss )
    
20.   (setq ss (ssadd))
    
21.   (MAPCAR '(LAMBDA (x) (ssadd x ss)) (apply 'append (vl-remove-if-not '(LAMBDA (x) (>= (length x) 2)) li)))
    
22.   (SSSETFIRST nil ss)
    
23.   )
    
24. (feng:ss:cir:1)

(defun feng:ss:cir:1 ( / ss li n tmp )<br />   (if (setq ss (ssget '((-4 . "<and") (0 . "CIRCLE") (-4 . "<or") (40 . 4.5) (40 . 7.0) (-4 . "or>") (-4 . "and>"))))<br />     (progn<br />       (repeat (setq n (sslength ss))<br />         (setq tmp (ssname ss (setq n (1- n)))<br />               li (cons (list tmp (cdr (assoc 10 (entget tmp)))) li))<br />         )<br />       (feng:ss:cir:3 (feng:ss:cir:2 li))<br />       )<br />     )<br />   )<br /> (defun feng:ss:cir:2 ( li / tmp )<br />   (if (setq tmp (vl-remove-if '(LAMBDA (x) (<= (abs (apply '+ (MAPCAR '- (cadr (car li)) (cadr x)))) 1e-05)) li))<br />     (append (list (MAPCAR 'car (VL-REMOVE-IF-NOT '(LAMBDA (x) (<= (abs (apply '+ (MAPCAR '- (cadr (car li)) (cadr x)))) 1e-05)) li))) (feng:ss:cir:2 tmp))<br />     (list (MAPCAR 'car li))<br />     )<br />   )<br /> (defun feng:ss:cir:3 ( li / ss )<br />   (setq ss (ssadd))<br />   (MAPCAR '(LAMBDA (x) (ssadd x ss)) (apply 'append (vl-remove-if-not '(LAMBDA (x) (>= (length x) 2)) li)))<br />   (SSSETFIRST nil ss)<br />   )<br /> (feng:ss:cir:1)