cad2004可否用cad2006里的修剪命令啊？

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

还有一个问题要请教，

可不可以实现在修剪的时候，

裁减边界可以亮显啊

谢谢。

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)
)

;; 可能还有 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

很好用，

感激的话我也不知道怎么说了，

论坛里有你这么热心的人

我感到很温暖，谢谢！

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

谢谢楼主,辛苦了!!!

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

请问你们可不可以帮我改好延伸命令啊....因为我是个完全不懂编程的菜鸟..

也是找了好久才找到你们的那个剪切命令..多谢你们啊...

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

http://bbs.mjtd.com/forum.php?mod=viewthread&tid=58824&replyID=&skin=1

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

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

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

用了一下还不错的谢谢

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

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

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

非常感谢

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