亮显相交对象----皇帝的新装!?

/db_自贡黄明儒_

;;为一位网友写了亮显相交对象,他说问题解决了,我却发现(sssetfirst nil SS1)不起作用了，只好用(command "erase" ss1 "")看效果，为什么呢?

2. 
   
3. ;;亮显相交对象
   
4. (defun C:w1 (/ I LST SS SS1 X Y)
   
5.   (defun Is-Ename (arg) (equal (type arg) 'ename))
   
6.   (defun pdpx (en1 en2 / KJ)
   
7.     (setq kj (mapcar 'vlax-ename->vla-object (list en1 en2)))
   
8.     (vlax-invoke (car kj) 'intersectwith (cadr kj) 0)
   
9.   )
   
10.   ;;120.1 [功能] 选择集->图元列表
    
11.   (defun MJ:SS->LIST (SS)
    
12.     (vl-remove-if-not 'Is-Ename (mapcar 'cadr (ssnamex SS)))
    
13.   )
    
14.   (setq ss1 (ssadd))
    
15.   (setq ss (ssget))
    
16.   (setq lst (MJ:SS->LIST ss))
    
17.   (mapcar '(lambda (x)
    
18.              (mapcar '(lambda (y)
    
19.                         (if (equal x y)
    
20.                           nil
    
21.                           (if (pdpx x y)
    
22.                             (progn (ssadd x ss1) (ssadd y ss1))
    
23.                           )
    
24.                         )
    
25.                       )
    
26.                      lst
    
27.              )
    
28.            )
    
29.           lst
    
30.   )
    
31.   ;;(repeat (setq i (sslength ss1))(redraw (ssname ss1 (setq i (1- 1))) 3))
    
32.   ;;(setvar "selectionpreview" 0)                                    ;06以上
    
33.   (sssetfirst nil SS1)
    
34.    ;;(command "erase" ss1 "")
    
35. )
    
36. 
    
37. ;;删除小于指定间距的圆
    
38. (defun C:w2 (/ DIS LST SS X Y)
    
39.   (defun Is-Ename (arg) (equal (type arg) 'ename))
    
40.   (defun pdpx (en1 en2)
    
41.     (distance (cdr (assoc 10 (entget en1))) (cdr (assoc 10 (entget en2))))
    
42.   )
    
43.   ;;120.1 [功能] 选择集->图元列表
    
44.   (defun MJ:SS->LIST (SS)
    
45.     (vl-remove-if-not 'Is-Ename (mapcar 'cadr (ssnamex SS)))
    
46.   )
    
47. 
    
48.   (if (and (setq ss (ssget '((0 . "Circle"))))
    
49.            (setq dis (getdist "\n输入最小距离: "))
    
50.       )
    
51.     (progn
    
52.       (setq lst (MJ:SS->LIST ss))
    
53.       (foreach x lst
    
54.         (foreach y lst
    
55.           (if (and (entget x) (entget y))
    
56.             (if        (equal x y)
    
57.               nil
    
58.               (if (< (pdpx x y) dis)
    
59.                 (progn (entdel x) (entdel Y))
    
60.               )
    
61.             )
    
62.           )
    
63.         )
    
64.       )
    
65.     )
    
66.   )
    
67. )
    

<br /> ;;亮显相交对象<br /> (defun C:w1 (/ I LST SS SS1 X Y)<br />   (defun Is-Ename (arg) (equal (type arg) 'ename))<br />   (defun pdpx (en1 en2 / KJ)<br />     (setq kj (mapcar 'vlax-ename->vla-object (list en1 en2)))<br />     (vlax-invoke (car kj) 'intersectwith (cadr kj) 0)<br />   )<br />   ;;120.1 [功能] 选择集->图元列表<br />   (defun MJ:SS->LIST (SS)<br />     (vl-remove-if-not 'Is-Ename (mapcar 'cadr (ssnamex SS)))<br />   )<br />   (setq ss1 (ssadd))<br />   (setq ss (ssget))<br />   (setq lst (MJ:SS->LIST ss))<br />   (mapcar '(lambda (x)<br />              (mapcar '(lambda (y)<br />                         (if (equal x y)<br />                           nil<br />                           (if (pdpx x y)<br />                             (progn (ssadd x ss1) (ssadd y ss1))<br />                           )<br />                         )<br />                       )<br />                      lst<br />              )<br />            )<br />           lst<br />   )<br />   ;;(repeat (setq i (sslength ss1))(redraw (ssname ss1 (setq i (1- 1))) 3))<br />   ;;(setvar "selectionpreview" 0)                                    ;06以上<br />   (sssetfirst nil SS1)<br />    ;;(command "erase" ss1 "")<br /> )<br /> <br /> ;;删除小于指定间距的圆<br /> (defun C:w2 (/ DIS LST SS X Y)<br />   (defun Is-Ename (arg) (equal (type arg) 'ename))<br />   (defun pdpx (en1 en2)<br />     (distance (cdr (assoc 10 (entget en1))) (cdr (assoc 10 (entget en2))))<br />   )<br />   ;;120.1 [功能] 选择集->图元列表<br />   (defun MJ:SS->LIST (SS)<br />     (vl-remove-if-not 'Is-Ename (mapcar 'cadr (ssnamex SS)))<br />   )<br /> <br />   (if (and (setq ss (ssget '((0 . "Circle"))))<br />            (setq dis (getdist "\n输入最小距离: "))<br />       )<br />     (progn<br />       (setq lst (MJ:SS->LIST ss))<br />       (foreach x lst<br />         (foreach y lst<br />           (if (and (entget x) (entget y))<br />             (if        (equal x y)<br />               nil<br />               (if (< (pdpx x y) dis)<br />                 (progn (entdel x) (entdel Y))<br />               )<br />             )<br />           )<br />         )<br />       )<br />     )<br />   )<br /> )<br />

newer

呵呵，你重启CAD，然后手工执行下 (sssetfirst nil SS1) ， SS1你赋个选集。看看行不。 来判断是否是你的程序代码的问题。

/db_自贡黄明儒_

newer 发表于 2013-12-3 12:32
呵呵，你重启CAD，然后手工执行下 (sssetfirst nil SS1) ， SS1你赋个选集。看看行不。 来判断是否是你的程 ...

重启cad也不行，手工执行(ssgetfirst nil (ssget))也不行。05不行，12也不行。你倒是提醒我了，我重启一下机器看行不行.

yangdafo

经使用，程序可用。

炫翔

:o别重定义了

/db_自贡黄明儒_

炫翔 发表于 2013-12-4 16:50
别重定义了

应该不是这个原因，近段时间来我就没添加新程序,除了安装《HI英文输入小助手》

xshrimp

应该和系统变量有关系吧?
(setvar "grips" 1)
试试??

/db_自贡黄明儒_

xshrimp 发表于 2013-12-5 22:19
应该和系统变量有关系吧?
(setvar "grips" 1)
试试??

也不行，看来不是这个原因

newer

/db_自贡黄明儒_ 发表于 2013-12-6 08:19
也不行，看来不是这个原因

夹点现在还能选择吗？

/db_自贡黄明儒_

newer 发表于 2013-12-6 08:52
夹点现在还能选择吗？

惨哟，其它都正常，就是(sssetfirst nil SS1)不行

newer

/db_自贡黄明儒_ 发表于 2013-12-6 10:43
惨哟，其它都正常，就是(sssetfirst nil SS1)不行

(TYPE SSSETFIRST) 还是函数吗？

不行，重装下CAD试试吧。

/db_自贡黄明儒_

newer 发表于 2013-12-6 10:54
(TYPE SSSETFIRST) 还是函数吗？

不行，重装下CAD试试吧。

我基本上不用12版，常用05版，现在情况是12版也有问题，应该是系统出了什么问题。
12版是正版Pccad，重装很麻烦，授权的问题。正版总不如盗版使用方便。{:soso_e113:}