求助CAD04以下框选剪切lsp，如何选块内单个线作剪切边

wowan1314 · 发表于 2012-3-29 13:38:26

本帖最后由 wowan1314 于 2012-3-29 20:31 编辑

如题！如何实现把块内单个线作为剪切边！！？ 有办法吗！
;;;==================================================

=========
;;;功能：可以点选和框选的修剪和延伸命令
;;;原创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")
 (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
;;;==================================================

=========

wowan1314 · 发表于 2012-3-29 16:28:11

自己顶顶！

langjs · 发表于 2012-3-29 16:47:06

我也帮你顶顶

wowan1314 · 发表于 2012-3-29 17:04:49

本帖最后由 wowan1314 于 2012-3-29 17:35 编辑

楼上高手帮忙多看看，给点建议啊！是不是哪个选择点鼠标变框的子程序不支持啊？

wowan1314 · 发表于 2012-3-29 17:59:38

改了半天，现在可以通过空格，enter来退出。就是不能右键退出。

wowan1314 · 发表于 2012-3-29 18:47:24

本帖最后由 wowan1314 于 2012-3-29 19:33 编辑

晕！终于搞出来了！把选择点鼠标变框改改就好了(原来的不支持右键).关键改(grread NIL 12 2)，(while pt1 ..
再加个分支：栏选
((= PT1 "F")
(PROGN (COMMAND CMD S1 "" "F")(COMAND "")))；栏选后回不到框选。

wowan1314 · 发表于 2012-3-29 18:59:28

本帖最后由 wowan1314 于 2012-3-30 14:21 编辑

就差选择块内线了！！！！选择块内单个线作为剪切边怎么实现呢？！块内的单线加不进选择集呀！
难道要选了块内线就把块彻底炸开，剪切完再还原？！

高手来解决下下！

xiaoyingzi · 发表于 2012-3-29 20:37:18

我也发个最接近06版，可框选，可点选，可栏选，可徒手选的超级剪切，源码来自狂刀，自己调整了下使之比较接近06版的剪切了

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;| xtr = 超级剪切－－狂刀 xiaoyingzi修改于2011-08-07，
思路from lijiao [url]http://www.xdcad.net/forum/showthread.php?postid=1686237#post1686237[/url]
可替代trim.
参数详解:
默认选择方式: 点到实体为点选；点于空位为框选，启动.
U-undo: 取消上次剪切操作，一键执行无须回车!
R-redo: 恢复一次undo操作，一键执行无须回车!
E-edgemode: 隐含边延伸模式 [不延伸(0)/延伸(1)]
P-projmode: 投影选项 [0 无 / 1 UCS / 2 视图]
F-栏选
S-徒手选: 自由画笔(sketch)方式.
C-框选: 框选实体边方式.
(按住Shift键延伸):同时按shift为延伸命令，而非剪切.
|;
(defun c:t (/ roop dis un cm os ed pr ss gr ga gb sel pt pt2 pts eg)
;;定义自己的出错函数
(defun error (msg)
(if (and
(/= msg "console break")
(/= msg "Function cancelled")
(/= msg "quit/exit abort")
)
(progn
(error_end)
(princ "\n")
(princ "*取消*")
)
)
)
;;定义自己的结尾恢复函数
(defun error_end ()
(if ss (redrawss ss 4 ))
(if os (setvar "osmode" os))
(if ed (setvar "edgemode" ed))
(if pr (setvar "projmode" pr))
(setq *error* olderr)
(command "undo" "e")
(if cm (setvar "cmdecho" cm))
)
;;显示隐藏亮显消隐函数 1.显示图元 2. 隐藏图元(使其不可见) 3.亮显图元 4.取消亮显图元
(defun redrawss (ss mode)
(mapcar '(lambda (x) (redraw x mode))
(vl-remove-if 'listp (mapcar 'cadr (ssnamex SS)))
)
(princ)
)
;;取得grread跟踪点表，dis为控制精度的距离.
(defun getpts (dis / gr pt pt0 pts)
(while (= 5 (car (setq gr (grread t 4 0))))
(setq pt (cadr gr))
(if (not pt0)
(setq pt0 pt
pts (cons pt0 pts)
)
)
(if (> (distance pt pt0) dis)
(progn
(grdraw pt pt0 1 1)
(setq pts (cons pt pts)
pt0 pt
)
)
)
)
(redraw)
(reverse pts)
)
;;开始主程序.
(command "undo" "be")
(princ
(strcat "\n当前设置:投影=" (nth (getvar "projmode") '("无" "UCS" "视图"))
"，边=" (nth (getvar "edgemode") '("不延伸" "延伸"))
)
)
(setq olderr *error* *error* error)
(setq roop T
dis (* 0.01 (getvar "viewsize"))
un 0
)
(setq cm (getvar "cmdecho")
os (getvar "osmode")
ed (getvar "edgemode")
pr (getvar "projmode")
)
(setvar "osmode" 0)
(setvar "cmdecho" 0)
(princ "\n选择对象或 <全部选择>: ")
(setq ss (ssget))
(if ss (redrawss ss 3 ))
(while roop
(princ
"\n选择要修剪的对象，或按住 Shift 键选择要延伸的对象，或 [栏选(F)/徒手选(S)/投影(P)/边(E)/重作(R)/放弃(U)]: "
)
(setq gr (grread nil 4 2)
ga (car gr)
gb (cadr gr)
)
(cond
((= ga 3)
(cond
;;点选.
((setq sel (nentselp gb))
(command "_.trim")
(if ss
(progn
(redrawss ss 3)
(command ss)
)
)
(command "")
(command sel "")
(if ss (redrawss ss 3))
)
;;框选.
(T
(if (and (setq pt gb)
(setq pt2 (getcorner pt "指定对角点: "))
)
(progn
(setq pts (list pt
(list (car pt) (cadr pt2))
pt2
(list (car pt2) (cadr pt))
)
)
(command "_.trim")
(if ss
(progn
(redrawss ss 3)
(command ss)
)
)
(command "")
(mapcar '(lambda (x y) (command "f" x y ""))
pts
(cons (last pts) pts)
)
(command "")
(if ss (redrawss ss 3))
(setq un (1+ un))
)
)
)
)
)
;;放弃(U).
((member gr '((2 117) (2 85)))
(if (> un 0)
(progn
(command "_.u")
(setq un (1- un))
)
(princ "\n没有操作可放弃")
)
)
;;重作(R).
((member gr '((2 114) (2 82)))
(setq un (1+ un))
(command "_.redo")
)
;;边(E).
((member gr '((2 101) (2 69)))
(progn
(initget 4)
(setq
XX (getint (strcat "\n输入隐含边延伸模式 [不延伸(0)/延伸(1)] <" (itoa (getvar "edgemode")) ">:" ) )
)
(if (or (= XX 0) (= XX 1))
(setvar "edgemode" XX)
)
)
)
;;投影(P)
((member gr '((2 112) (2 80)))
(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)
)
)
)
;;徒手选(S).
((member gr '((2 115) (2 83)))
(setq pts (getpts dis))
(if (setq pts2 (cdr pts))
(progn (command "_.trim")
(if ss
(progn
(redrawss ss 3)
(command ss)
)
)
(command "")
(mapcar '(lambda (x y) (command "f" x y "")) pts pts2)
(command "")
(if ss (redrawss ss 3))
)
)
)
;;栏选(F).
((member gr '((2 102) (2 70)))
(setq pt (getpoint "\n第一栏选点: "))
(if (setq pt2 (getpoint pt "\n指定直线的端点: "))
(progn (command "_.trim")
(if ss
(progn
(redrawss ss 3)
(command ss)
)
)
(command "" "f" pt pt2 "")
(command "")
(if ss (redrawss ss 3))
)
)
)
;;空格或回车.
((member gr '((11 0) (2 32)))
(setq roop nil)
)
)
)
(error_end)
(princ)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
;| xtr = 超级剪切－－狂刀 xiaoyingzi修改于2011-08-07， 
   思路from lijiao  [url]http://www.xdcad.net/forum/showthread.php?postid=1686237#post1686237[/url] 
   可替代trim. 
   参数详解: 
   默认选择方式: 点到实体为点选；点于空位为框选，启动. 
   U-undo: 取消上次剪切操作，一键执行无须回车! 
   R-redo: 恢复一次undo操作，一键执行无须回车! 
   E-edgemode: 隐含边延伸模式 [不延伸(0)/延伸(1)] 
   P-projmode: 投影选项 [0 无 / 1 UCS / 2 视图] 
   F-栏选 
   S-徒手选: 自由画笔(sketch)方式. 
   C-框选:  框选实体边方式. 
     (按住Shift键延伸):同时按shift为延伸命令，而非剪切. 
|; 
 
(defun c:t (/ roop dis un cm os ed pr ss gr ga gb sel pt pt2 pts eg) 
 
  ;;定义自己的出错函数 
  (defun error (msg)       
    (if  (and 
    (/= msg "console break") 
    (/= msg "Function cancelled") 
    (/= msg "quit/exit abort") 
  ) 
      (progn 
  (error_end) 
  (princ "\n") 
  (princ "*取消*") 
      ) 
    ) 
  ) 
 
  ;;定义自己的结尾恢复函数 
  (defun error_end () 
    (if ss (redrawss ss 4 )) 
    (if  os (setvar "osmode" os)) 
    (if  ed (setvar "edgemode" ed)) 
    (if  pr (setvar "projmode" pr)) 
    (setq *error* olderr) 
    (command "undo" "e") 
    (if  cm (setvar "cmdecho" cm)) 
  ) 
 
  ;;显示隐藏亮显消隐函数 1.显示图元 2. 隐藏图元(使其不可见) 3.亮显图元 4.取消亮显图元 
  (defun redrawss (ss mode) 
     (mapcar '(lambda (x) (redraw x mode)) 
             (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS))) 
     ) 
  (princ) 
  ) 
 
  ;;取得grread跟踪点表，dis为控制精度的距离. 
  (defun getpts  (dis / gr pt pt0 pts) 
    (while (= 5 (car (setq gr (grread t 4 0)))) 
      (setq pt (cadr gr)) 
      (if (not pt0) 
  (setq pt0 pt 
        pts (cons pt0 pts) 
  ) 
      ) 
      (if (> (distance pt pt0) dis) 
  (progn 
    (grdraw pt pt0 1 1) 
    (setq  pts (cons pt pts) 
    pt0 pt 
    ) 
  ) 
      ) 
    ) 
    (redraw) 
    (reverse pts) 
  ) 
 
  ;;开始主程序. 
  (command "undo" "be") 
  (princ 
     (strcat "\n当前设置:投影=" (nth (getvar "projmode") '("无" "UCS" "视图")) 
              "，边=" (nth (getvar "edgemode") '("不延伸" "延伸")) 
     ) 
  ) 
  (setq  olderr *error* *error* error) 
  (setq  roop T 
  dis  (* 0.01 (getvar "viewsize")) 
  un   0 
  ) 
  (setq  cm (getvar "cmdecho") 
  os (getvar "osmode") 
  ed (getvar "edgemode") 
  pr (getvar "projmode") 
  ) 
  (setvar "osmode" 0) 
  (setvar "cmdecho" 0) 
  (princ "\n选择对象或 <全部选择>: ") 
  (setq ss (ssget)) 
  (if ss (redrawss ss 3 )) 
  (while roop 
    (princ 
      "\n选择要修剪的对象，或按住 Shift 键选择要延伸的对象，或 [栏选(F)/徒手选(S)/投影(P)/边(E)/重作(R)/放弃(U)]: " 
    ) 
    (setq gr (grread nil 4 2) 
    ga (car gr) 
    gb (cadr gr) 
    ) 
    (cond 
      ((= ga 3) 
       (cond 
   ;;点选. 
   ((setq sel (nentselp gb)) 
    (command "_.trim") 
    (if ss 
      (progn 
              (redrawss ss 3) 
        (command ss) 
            ) 
    ) 
    (command "") 
    (command sel "") 
          (if ss (redrawss ss 3)) 
   ) 
   ;;框选. 
   (T 
      (if  (and (setq pt gb) 
         (setq pt2 (getcorner pt "指定对角点: ")) 
    ) 
        (progn 
    (setq pts (list  pt 
        (list (car pt) (cadr pt2)) 
        pt2 
        (list (car pt2) (cadr pt)) 
        ) 
    ) 
    (command "_.trim") 
    (if ss 
            (progn 
                  (redrawss ss 3) 
      (command ss) 
                  ) 
    ) 
    (command "") 
    (mapcar  '(lambda (x y) (command "f" x y "")) 
      pts 
      (cons (last pts) pts) 
    ) 
    (command "") 
                (if ss (redrawss ss 3)) 
    (setq un (1+ un)) 
        ) 
      ) 
   ) 
       ) 
      ) 
      ;;放弃(U). 
      ((member gr '((2 117) (2 85))) 
       (if (> un 0) 
   (progn 
     (command "_.u") 
     (setq un (1- un)) 
   ) 
   (princ "\n没有操作可放弃") 
       ) 
      ) 
      ;;重作(R). 
      ((member gr '((2 114) (2 82))) 
       (setq un (1+ un)) 
       (command "_.redo") 
      ) 
      ;;边(E). 
      ((member gr '((2 101) (2 69))) 
       (progn 
       (initget 4) 
       (setq 
           XX (getint (strcat "\n输入隐含边延伸模式 [不延伸(0)/延伸(1)] <" (itoa (getvar "edgemode")) ">:" ) ) 
       ) 
       (if (or (= XX 0) (= XX 1)) 
             (setvar "edgemode" XX) 
       ) 
       ) 
      ) 
      ;;投影(P) 
      ((member gr '((2 112) (2 80))) 
       (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) 
       ) 
       ) 
      ) 
      ;;徒手选(S). 
      ((member gr '((2 115) (2 83))) 
       (setq pts (getpts dis)) 
       (if (setq pts2 (cdr pts)) 
      (progn (command "_.trim") 
       (if ss             
                     (progn 
                       (redrawss ss 3) 
           (command ss) 
                     ) 
       ) 
       (command "") 
       (mapcar '(lambda (x y) (command "f" x y "")) pts pts2) 
       (command "") 
                   (if ss (redrawss ss 3)) 
      ) 
       ) 
      ) 
      ;;栏选(F). 
      ((member gr '((2 102) (2 70))) 
       (setq pt (getpoint "\n第一栏选点: ")) 
       (if (setq pt2 (getpoint pt "\n指定直线的端点: ")) 
      (progn (command "_.trim") 
       (if ss             
                     (progn 
                       (redrawss ss 3) 
           (command ss) 
                     ) 
       ) 
       (command "" "f" pt pt2 "") 
       (command "") 
                   (if ss (redrawss ss 3)) 
      ) 
       ) 
      ) 
      ;;空格或回车. 
      ((member gr '((11 0) (2 32))) 
       (setq roop nil) 
      ) 
 
    ) 
  ) 
  (error_end) 
  (princ) 
)

wowan1314 · 发表于 2012-3-29 20:57:04

楼上的栏选只能两点！右键不能退出（估计按我改得那样改改也能实现）！
块跟线一起选不能剪切！块内单个线也不能选呢！

不过还是感谢你的参与! 看来喜欢CAD2004的还是有些人的！呵呵

429014673 · 发表于 2012-3-30 11:22:56

xiaoyingzi 发表于 2012-3-29 20:37
我也发个最接近06版，可框选，可点选，可栏选，可徒手选的超级剪切，源码来自狂刀，自己调整了下使之比较接 ...

右键不能退出

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

求助CAD04以下框选剪切lsp，如何选块内单个线作剪切边

本帖子中包含更多资源

点评

相关帖子