社区 › AutoLISP/Visual LISP 编程技术 › cad2004可否用cad2006里的修剪命令啊？

56216349 发表于 2007-3-24 08:22:00

<p>还有一个问题要请教，</p><p>可不可以实现在修剪的时候，</p><p>裁减边界可以亮显啊</p><p>谢谢。</p>

caoyin 发表于 2007-3-24 13:05:00

;; 可能还有 bug ，不是太好用
(defun c:tr (/ trerror trerror_end olderr ssRedraw cm os ss1 ss2 ssn lst pb)
(defun trerror (x) (trerror_end))
(defun trerror_end ()
    (if ss1 (ssRedraw ss1 4))
    (setq *error* olderr)
)
(setq olderr *error* *error* trerror)
(defun ssRedraw (ss mode)
    (mapcar '(lambda (x) (redraw x mode))
            (vl-remove-if-not '(lambda (x) (= (type x) 'ename)) (mapcar 'cadr (ssnamex ss)))
    )
)
(setq cm (getvar "cmdecho")
      os (getvar "osmode")
)
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(princ "\n选择剪切边或 <全部选择>...")
(setq ss1 (ssget))
(if ss1 (ssRedraw ss1 3))
(princ "\n选择要修剪的对象...")
(setq ss2 (ssget))
(if ss2
    (progn
      (setq ssn (ssnamex ss2))
      (cond
      ((= (caar ssn) 3);;框选
         (setq lst (mapcar '(lambda (x) (mapcar' cadr x))
                           (mapcar 'cdr (vl-remove-if-not '(lambda (x) (< (car x) 0)) ssn))
                   )
               lst (mapcar '(lambda (x) (append x (list (car x)))) lst)
         )
      )
      ((= (caar ssn) 1);;单选
         (setq lst (mapcar 'cadr (mapcar 'last ssn))
               pb(abs (/ (* (/ (getvar "pickbox") (cadr (getvar "screensize")))
                              (getvar "viewsize")
                           )
                           (sin (/ pi 4))
                        )
                   )
               lst (mapcar '(lambda (x)
                           (list (polar x (* 0.25 pi) pb)
                                 (polar x (* 0.75 pi) pb)
                                 (polar x (* 1.25 pi) pb)
                                 (polar x (* 1.75 pi) pb)
                                 (polar x (* 0.25 pi) pb)
                           )
                            )
                            lst
                   )
         )
      )
      )
      (if lst
      (progn
          (command "_.trim")
          (if ss1
            (command ss1 "")
            (command "")
          )
          (mapcar '(lambda (x)
                  (command "_f")
                  (apply 'command x)
                  (command "")
                   )
                  lst
          )
         (command "")
      )
      )
    )
)
(if ss1 (ssRedraw ss1 4))
(setvar "cmdecho" cm)
(setvar "osmode" os)
(trerror_end)
(princ)
)

56216349 发表于 2007-3-25 09:40:00

<p>很好用，</p><p>感激的话 我也不知道怎么说了，</p><p>论坛里有你这么热心的人</p><p>我感到很温暖，谢谢！</p><p></p>

honxj 发表于 2007-3-31 22:15:00

<p>谢谢楼主,辛苦了!!!</p>

zxlwinno1 发表于 2007-6-25 13:52:00

<p>请问你们可不可以帮我改好延伸命令啊....因为我是个完全不懂编程的菜鸟..</p><p>也是找了好久才找到你们的那个剪切命令..多谢你们啊...</p>

caoyin 发表于 2007-6-25 14:18:00

<a href="http://bbs.mjtd.com/forum.php?mod=viewthread&tid=58824&amp;replyID=&amp;skin=1">http://bbs.mjtd.com/forum.php?mod=viewthread&tid=58824&amp;replyID=&amp;skin=1</a>

zxlwinno1 发表于 2007-6-25 14:52:00

你们太好人了...好感动啊...

lang308 发表于 2008-8-4 17:00:00

<p>用了一下还不错的 谢谢</p>

CAD83 发表于 2008-8-4 21:15:00

<p>延伸命令是不是也可以啊？还有高手宝宝写个吧，</p>

youyanse 发表于 2008-9-3 11:51:00

非常感谢

查看完整版本: cad2004可否用cad2006里的修剪命令啊？