[原创]：刚写的一个小家伙

lijiao · 发表于 2004-6-17 11:31:13

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

如题

[FONT=courier new]
(defun c:cs_del (/ ss pt pt1 fs)
(while (and (setq ss (zntq nil))
(= (type (cadr ss)) 'list)
)
(if (car ss)
(entdel (car ss))
(if (setq pt1 (getcorner (setq pt (cadr ss))))
(progn
(if (> (car pt1) (car pt))
(setq fs "w")
(setq fs "c")
)
(if (setq ss (ssget fs pt pt1))
(command "erase" ss "")
)
)
)
)
)
(princ)
)
(defun zntq (nam / pt ss_name biaoji ss)
(setq biaoji t)
(while biaoji
(setq pt (grread t 4 2))
(cond
((= 5 (car pt))
(setq ss (ssget (cadr pt) nam))
(if ss_name
(redraw ss_name 4)
)
(setq ss_name nil)
(if ss
(progn
(setq ss_name (ssname ss 0))
(redraw ss_name 3)
)
)
)
((= 3 (car pt))
(setq ss (ssget (cadr pt) nam))
(if ss_name
(redraw ss_name 4)
)
(setq ss_name nil)
(if ss
(progn
(setq ss_name (ssname ss 0))
(redraw ss_name 3)
)
)
(setq biaoji nil)
)
((or (= (car pt) 25)
(and (= (car pt) 2)
(or (= (cadr pt) 13)
(= (cadr pt) 32)
)
)
)
(setq biaoji nil
ss_name nil
)
)
(t (princ))
)
)
(if ss_name
(redraw ss_name 4)
)
(list ss_name (cadr pt))
)
[/FONT]

[FONT=courier new] 
(defun c:cs_del        (/ ss pt pt1 fs) 
  (while (and (setq ss (zntq nil)) 
              (= (type (cadr ss)) 'list) 
         ) 
    (if        (car ss) 
      (entdel (car ss)) 
      (if (setq pt1 (getcorner (setq pt (cadr ss)))) 
        (progn 
          (if (> (car pt1) (car pt)) 
            (setq fs "w") 
            (setq fs "c") 
          ) 
          (if (setq ss (ssget fs pt pt1)) 
            (command "erase" ss "") 
          ) 
        ) 
      ) 
    ) 
  ) 
  (princ) 
) 
(defun zntq (nam / pt ss_name biaoji ss) 
  (setq biaoji t) 
  (while biaoji 
    (setq pt (grread t 4 2)) 
    (cond 
      ((= 5 (car pt)) 
       (setq ss (ssget (cadr pt) nam)) 
       (if ss_name 
         (redraw ss_name 4) 
       ) 
       (setq ss_name nil) 
       (if ss 
         (progn 
           (setq ss_name (ssname ss 0)) 
           (redraw ss_name 3) 
         ) 
       ) 
      ) 
      ((= 3 (car pt)) 
       (setq ss (ssget (cadr pt) nam)) 
       (if ss_name 
         (redraw ss_name 4) 
       ) 
       (setq ss_name nil) 
       (if ss 
         (progn 
           (setq ss_name (ssname ss 0)) 
           (redraw ss_name 3) 
         ) 
       ) 
       (setq biaoji nil) 
      ) 
      ((or (= (car pt) 25) 
           (and        (= (car pt) 2) 
                (or (= (cadr pt) 13) 
                    (= (cadr pt) 32) 
                ) 
           ) 
       ) 
       (setq biaoji nil 
             ss_name nil 
       ) 
      ) 
      (t (princ)) 
    ) 
  ) 
  (if ss_name 
    (redraw ss_name 4) 
  ) 
  (list ss_name (cadr pt)) 
) 
  [/FONT]

自由的鱼 · 发表于 2004-6-17 12:14:14

是做什么用的？楼主能介绍一下吗？

chstart · 发表于 2004-6-17 12:32:15

好程序，删除也可以变得这么动态、快捷了。
不过不支持透明命令，想pan zoom 一下就不行，能改善吗？

陌生人 · 发表于 2004-6-17 12:36:43

建议以后写程序注明功能，用法，函数变量的含义（如果有的话）

aaddff · 发表于 2004-6-17 13:05:19

不错，学习学习再学习

陌生人 · 发表于 2004-6-17 13:47:42

我觉得cad的erase已经很好用了。
楼主的程序最好能支持在程序内部undo。

xiaohero · 发表于 2004-6-17 14:12:02

一个好的程序应该是包括:好的程序代码和详细的程序注释.
大侠们应该给我们这些新来的做好榜样,带好头.
这样也便于大家交流!!!

lijiao · 发表于 2004-6-17 14:13:23

这个东西是我突发奇想，花了不到10分钟的时间写的（就是前面主程序，后面那个函数是以前写的，并且在论坛上贴过），没有考虑它是否适用，也没有做UNDO以及错误处理等。
没想到引来这么多争议，XDsoft还给了5枚爱心币，可是，我用了很多时间才写出来的那个“高效的合并直线程序”，却没有得到任何奖励，有点不明白，也有点想不通（一句玩笑话）。

andyhua5240 · 发表于 2004-6-17 14:39:35

TO三楼：
要是你用2000以上的版本的话，用鼠标平移，缩放，就没有问题呀，我试了的！

liuyj · 发表于 2004-6-17 14:45:27

有时候就是这样，辛苦半天不一定有什么奖励，不过看到有那么多人参与讨论，应该也很高兴的。你那个合并直线的程序，下面有我对ea版主的提问，他还没解决，你要不要试试？

lijiao · 发表于 2004-6-17 16:35:45

最初由 liuyj 发布
[B]有时候就是这样，辛苦半天不一定有什么奖励，不过看到有那么多人参与讨论，应该也很高兴的。你那个合并直线的程序，下面有我对ea版主的提问，他还没解决，你要不要试试？ [/B]

还是有知音的，哈哈哈哈！
＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
关于合并直线的问题，我的目的是要合并有重叠的；如果没有重叠的也要合并的话，程序会更简单，论坛中也有我贴出的代码。
至于加入对圆弧的处理，我看就不必做了吧，ET工具中的OVERKILL比我的程序出色，早知道有这个命令，我也不会费劲去写合并直线了。哈哈哈哈。

陌生人 · 发表于 2004-6-17 18:01:24

你那个程序是应该加分
但是现在本板块各个版主加分的尺度参差太大，xd有必要开个小会，统一一下尺度：）

自由的鱼 · 发表于 2004-6-17 19:01:26

总之有程序就好，大家可以一起进步，钱和积分都是次要的！

eachy · 发表于 2004-6-17 19:47:05

最初由 lijiao 发布
[B]这个东西是我突发奇想，花了不到10分钟的时间写的（就是前面主程序，后面那个函数是以前写的，并且在论坛上贴过），没有考虑它是否适用，也没有做UNDO以及错误处理等。
没想到引来这么多争议，XDsoft还给了5枚爱心?.. [/B]

哈哈，我也想不通：）

to liuyj：这两天事多没有改程序，这几天之内加上，可以和 OVERKILL 比较比较看看俺的Lisp效率如何。

陌生人 · 发表于 2004-6-17 20:33:10

最初由 eachy 发布
to liuyj：这两天事多没有改程序，这几天之内加上，可以和 OVERKILL 比较比较看看俺的Lisp效率如何。[/B]

好啊，我等着看好戏啦。
lijiao，自由的鱼，还有其它的，你们也要百花齐放啊。。。。：）

账号		自动登录	找回密码
密码			立即注册

[原创]：刚写的一个小家伙

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子