删除重叠块的程序（最新版）。

6224jjyy

(defun c:KK (/ pt ss ss1 ss_m ent name1 name2 name3)
  (setq p1 (getpoint "\n请输入第一角:"))
  (setq p2 (getcorner p1 "\n请输入第二角:"))
  (setq ss (ssget "w" p1 p2 '((0 . "INSERT"))))
  (setq ss_m (ssadd))
  (while (and ss (> (sslength ss) 1))
    (setq ent (ssname ss 0))
    (setq pt (cdr (assoc 10 (entget ent)))
    name1 (cdr (assoc 2 (entget ent)))
    name2 (cdr (assoc 41 (entget ent)))
    name3 (cdr (assoc 50 (entget ent)))
    ss1 (ssget "w" p1 p2 (list (cons 0 "INSERT")(cons 10 pt)
        (cons 2 name1)(cons 41 name2)(cons 50 name3)))
    )
    (if (and ss1 (> (sslength ss1) 1))
      (progn
      (ssdel (ssname ss1 0) ss1)
      (command "select" ss_m ss1 "")
      (setq ss_m (ssget "P"))
      )
    )
    (command "select" ss "r" ent "")
    (setq ss (ssget "P"))
  )
  (sssetfirst nil ss_m)
  (if (> (sslength ss_m) 0)
    (progn
    (setq p0 (getpoint p2 "\n移动至..."))
    (sssetfirst nil)
    (setq i 0)
      (repeat (sslength ss_m)
      (setq s1 (ssname ss_m i))
      (setq p10 (cdr (assoc 10 (entget s1))))
      (command "move" s1 "" p10 p0)
      (command "line" p10 p0 "")
      (setq p0 (polar p0 0 800))
      (setq i (1+ i))
      )
    )
  )

6224jjyy

研究了大半天。。实在是弄不明白了，特此来求助。。

xyp1964

2. ;; tt(重复图块移位) 2015-12-10
   
3. (defun c:tt ()
   
4.   (defun dxf (code s1) (cdr (assoc code (entget s1))))
   
5.   (setvar "osmode" 0)
   
6.   (if (and (setq p1 (getpoint "\n请输入第一角: "))
   
7.            (setq p2 (getcorner p1 "\n请输入第二角: "))
   
8.            (setq ss (ssget "w" p1 p2 '((0 . "INSERT"))))
   
9.       )
   
10.     (progn
    
11.       (setq i         -1
    
12.             ss-m (ssadd)
    
13.       )
    
14.       (while (setq s1 (ssname ss (setq i (1+ i))))
    
15.         (if (not (ssmemb s1 ss-m))
    
16.           (progn
    
17.             (setq lst (list '(0 . "INSERT")
    
18.                             (cons 10 (DXF 10 s1))
    
19.                             (cons 2 (DXF 2 s1))
    
20.                             (cons 41 (DXF 41 s1))
    
21.                             (cons 50 (DXF 50 s1))
    
22.                       )
    
23.                   ss1 (ssget "w" p1 p2 lst)
    
24.             )
    
25.             (if        (> (sslength ss1) 1)
    
26.               (progn
    
27.                 (setq ss1 (ssdel s1 ss1))
    
28.                 (command "select" ss1 ss-m "")
    
29.                 (setq ss-m (ssget "P"))
    
30.               )
    
31.             )
    
32.           )
    
33.         )
    
34.       )
    
35.       (if (> (sslength ss-m) 0)
    
36.         (progn
    
37.           (setq        p0 (getpoint p2 "\n移动至...")
    
38.                 i  0
    
39.           )
    
40.           (repeat (sslength ss-m)
    
41.             (setq s1 (ssname ss-m i))
    
42.             (setq p10 (cdr (assoc 10 (entget s1))))
    
43.             (command "move" s1 "" p10 p0)
    
44.             (command "line" p10 p0 "")
    
45.             (setq i (1+ i))
    
46.           )
    
47.         )
    
48.       )
    
49.     )
    
50.   )
    
51.   (princ)
    
52. )

;; tt(重复图块移位) 2015-12-10<br /> (defun c:tt ()<br />   (defun dxf (code s1) (cdr (assoc code (entget s1))))<br />   (setvar "osmode" 0)<br />   (if (and (setq p1 (getpoint "\n请输入第一角: "))<br />            (setq p2 (getcorner p1 "\n请输入第二角: "))<br />            (setq ss (ssget "w" p1 p2 '((0 . "INSERT"))))<br />       )<br />     (progn<br />       (setq i         -1<br />             ss-m (ssadd)<br />       )<br />       (while (setq s1 (ssname ss (setq i (1+ i))))<br />         (if (not (ssmemb s1 ss-m))<br />           (progn<br />             (setq lst (list '(0 . "INSERT")<br />                             (cons 10 (DXF 10 s1))<br />                             (cons 2 (DXF 2 s1))<br />                             (cons 41 (DXF 41 s1))<br />                             (cons 50 (DXF 50 s1))<br />                       )<br />                   ss1 (ssget "w" p1 p2 lst)<br />             )<br />             (if        (> (sslength ss1) 1)<br />               (progn<br />                 (setq ss1 (ssdel s1 ss1))<br />                 (command "select" ss1 ss-m "")<br />                 (setq ss-m (ssget "P"))<br />               )<br />             )<br />           )<br />         )<br />       )<br />       (if (> (sslength ss-m) 0)<br />         (progn<br />           (setq        p0 (getpoint p2 "\n移动至...")<br />                 i  0<br />           )<br />           (repeat (sslength ss-m)<br />             (setq s1 (ssname ss-m i))<br />             (setq p10 (cdr (assoc 10 (entget s1))))<br />             (command "move" s1 "" p10 p0)<br />             (command "line" p10 p0 "")<br />             (setq i (1+ i))<br />           )<br />         )<br />       )<br />     )<br />   )<br />   (princ)<br /> )

6224jjyy

xyp1964 发表于 2015-12-10 22:52

非常感谢。。我先保存了，明天再研究

6224jjyy

xyp1964 发表于 2015-12-10 22:52

我代码的错误找到了，你再帮看看，我修改后的代码，有什么问题吗？

还有，你的代码，写在一个框里，怎么做到的？