[求助]谁会写一个像2006这样的剪切功能？

langjs

;;;===========================================================
;;;功能：可以点选和框选的修剪和延伸命令
;;;原创ZML84，由langjs修改于2009-05-07
;;;===========================================================

(defun c:kxjq () (trim&extend T)  )
(defun c:kxys () (trim&extend nil) )

(defun trim&extend (cmd / S1 S2 PT1 PT2 CMDECHO_OLD I XX  zhuj1)
   (if cmd
      (setq cmd "_.trim"  zhuj1  "\n选择剪切边,或:<选择全部>:"  zhuj2    "\n选择要修剪的对象，或 [投影(P)/边(E)/放弃(U)]:" )
      (setq cmd "_.extend"  zhuj1  "\n选择边界的边,或:<选择全部>:"  zhuj2   "\n选择要延伸的对象，或 [投影(P)/边(E)/放弃(U)]:" )
   )
   (defun error (x) (error_end))
   (defun error_end ()
      (liangxian s1 4 )
      (setvar "osmode" snap) 打开捕捉
      (if cm (setvar "cmdecho" cm))
      (if os (setvar "osmode" os))
      (setq *error* olderr)
   )
   (setq olderr *error* *error* error)
   (setq CMDECHO_OLD (getvar "CMDECHO"))
   (setvar "CMDECHO" 0)
   (setq liangx   1)
   (princ zhuj1)
   ;;若没有选取边界，就将全部对象作为边界
   (setvar "nomutt" 1)
   (if (setq S1 (ssget))
      ()
      (progn
         (setq S1 (ssget "all"))
         (setq liangx   0)
      )
   )
   (setvar "nomutt" 0)
   (setq snap (getvar "osmode"))
   (setvar "osmode" 0) ;关闭
   (liangxian s1 3 )
   (while t
      (initget 4 "P E U  p e u ")
      (QQQ)
      (princ zhuj2)
  (cond
      ;;分支零：右键退出
        ((= PT1 0.0)
         (exit))

      ;;分支一：投影选项设置
        ((= PT1 "P")
       (progn
       (initget 4)
       (setq
           XX (getint (strcat "\n输入投影选项 [无(0)/UCS(1)/视图(2)] <" (itoa (getvar "PROJMODE"))  ">:"  ) )
       )
       (if (or (= XX 0) (= XX 1) (= XX 2))
             (setvar "PROJMODE" XX)
       )
       )
      )
      ;;分支二：边延伸选项设置
        ((= PT1 "E")
       (progn
       (initget 4)
       (setq XX (getint
                (strcat
                  "\n输入隐含边延伸模式 [不延伸(0)/延伸(1)] <"
                  (itoa (getvar "EDGEMODE"))
                  ">:"
                )
            )
       )
       (if (or (= XX 0) (= XX 1))
             (setvar "EDGEMODE" XX)
       )
       )
      )
      ;;分支四：撤销上一步操作
        ((= PT1 "U")
         (command "_.undo" 1)
      )
      ;;分支五：对选中的对象进行修剪操作
      ((listp PT1)
      (progn
      (if (setq S2 (ssget PT1))
          (progn
             (command "_.undo" "be")
             (command cmd S1 "" S2 "")
             (command "_.undo" "e")
             (liangxian s1 3 )
          )
          (if (and (setq PT2 (getcorner PT1 " >>>第二角点: " ) )
                   (setq S2 (ssget "c" PT1 PT2))
              )
             (progn
                (command "_.undo" "be")
                (command cmd S1 "")
                (setq I 0)
                (repeat (sslength S2)
                   (command  (list (ssname S2 I) PT1))
                   (setq I (1+ I))
                )
                (command "")
                (command "_.undo" "e")
                (liangxian s1 3 )
             )
             (princ "\n★未选择到对象。")
         )
     )
     )
      ) ;_结束 分支五
  ) ;_结束 cond 结束分支
   ) ;_结束 while
   (liangxian s1 4 )
   (setvar "CMDECHO" CMDECHO_OLD)
   (setvar "osmode" snap) 打开捕捉
   (error_end)
   (princ)
) ;_结束 defun

(defun qqq ();;;选择点鼠标变成框子程序
   (princ zhuj2)

   (while (not (member (car (setq PT1 (grread T 12 2))) '(3 2 11)))
      (setq PT1 (cadr PT1))
      (if (vl-consp PT1)
        (progn
          (or PT (setq PT PT1))
          (setq X (car PT) Y (cadr PT))
          (if (> (distance PT1 PT) (P2U222 (* 0.0001 (car (getvar "screensize")))))
            (progn
              (redraw)
              (setq LEN (P2U222 1) X (car PT) Y (cadr PT))
              (setq PT PT1)
            )
          )
        )
      )
    )
    (redraw)
    (and (= (car PT1) 3)
         (vl-consp (cadr PT1))
         (setq EN (nentselp (cadr PT1)))
    )
   (setq ent (car EN)  PT1 (cadr PT1)   )
   (cond ((or (= PT1 80) (= PT1 112))  (setq PT1 "P"))
         ((or (= PT1 69) (= PT1 101))  (setq PT1 "E"))
         ((or (= PT1 85) (= PT1 117))  (setq PT1 "U"))
   )
   ( if (= PT1 0.0)  (setvar "osmode" snap) );打开捕捉
   (princ)
)

(defun p2u222 (pix) (* pix (/ (getvar "viewsize") (cadr (getvar "screensize")))))

(defun liangxian (ss  n / slen I  ent );;控制选择集亮显程序
   (if  (/= liangx 0);;亮显判断条件
        (progn
        (setq slen (sslength ss) I 0 )
        (while (ssname ss I)
           (setq ent (ssname ss I))
           (redraw ent n);亮显
           (setq I (+ 1 I))
        );end while
        );end progn
   );end if
);end defun
;;;===========================================================

clh521

程序不错哦，收集了

luyu9635

我也来凑凑热闹,整理和修改和几位高手的程序,在此感谢了

 

wowan1314

<p>1、哎，都是无法实现块内线作为剪切边啊！</p><p>2、剪切完后无法右键退出。</p><p>3、当剪切的两条线一个很长一个很短时，框选两条线程序剪错。</p>