6224jjyy 发表于 2015-12-10 21:37:59

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

本帖最后由 6224jjyy 于 2018-5-10 19:56 编辑

(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 发表于 2015-12-10 21:53:19

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

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

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

6224jjyy 发表于 2015-12-10 23:24:08

xyp1964 发表于 2015-12-10 22:52 static/image/common/back.gif


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

6224jjyy 发表于 2015-12-11 22:58:47

本帖最后由 6224jjyy 于 2015-12-12 09:30 编辑

xyp1964 发表于 2015-12-10 22:52 static/image/common/back.gif我代码的错误找到了，你再帮看看，我修改后的代码，有什么问题吗？

还有，你的代码，写在一个框里，怎么做到的？
页: [1]
查看完整版本: 删除重叠块的程序（最新版）。