明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 5328|回复: 12

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

  [复制链接]
发表于 2012-3-29 13:38 | 显示全部楼层 |阅读模式
本帖最后由 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
;;;==================================================

=========


本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x

点评

命令: KXJQ 选择剪切边,或:<选 择全部>: 选择要修剪的对象,或 [投影(P)/ 边(E)/放弃(U)]:; 错误: *error* 函数中出错参数值错误: AutoCAD 变量值: #<SUBR @03eaabcc OS>  发表于 2012-3-30 11:25
"觉得好,就打赏"
还没有人打赏,支持一下
 楼主| 发表于 2012-3-29 16:28 | 显示全部楼层
自己顶顶!
发表于 2012-3-29 16:47 | 显示全部楼层
我也帮你顶顶
 楼主| 发表于 2012-3-29 17:04 | 显示全部楼层
本帖最后由 wowan1314 于 2012-3-29 17:35 编辑

楼上高手帮忙多看看,给点建议啊!是不是哪个选择点鼠标变框的子程序不支持啊?
 楼主| 发表于 2012-3-29 17:59 | 显示全部楼层
改了半天,现在可以通过空格,enter来退出。就是不能右键退出。
 楼主| 发表于 2012-3-29 18:47 | 显示全部楼层
本帖最后由 wowan1314 于 2012-3-29 19:33 编辑

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



 楼主| 发表于 2012-3-29 18:59 | 显示全部楼层
本帖最后由 wowan1314 于 2012-3-30 14:21 编辑

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

高手来解决下下!
发表于 2012-3-29 20:37 | 显示全部楼层
我也发个最接近06版,可框选,可点选,可栏选,可徒手选的超级剪切,源码来自狂刀,自己调整了下使之比较接近06版的剪切了
  1. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  2. ;| xtr = 超级剪切--狂刀 xiaoyingzi修改于2011-08-07,
  3.    思路from lijiao  [url]http://www.xdcad.net/forum/showthread.php?postid=1686237#post1686237[/url]
  4.    可替代trim.
  5.    参数详解:
  6.    默认选择方式: 点到实体为点选;点于空位为框选,启动.
  7.    U-undo: 取消上次剪切操作,一键执行无须回车!
  8.    R-redo: 恢复一次undo操作,一键执行无须回车!
  9.    E-edgemode: 隐含边延伸模式 [不延伸(0)/延伸(1)]
  10.    P-projmode: 投影选项 [0 无 / 1 UCS / 2 视图]
  11.    F-栏选
  12.    S-徒手选: 自由画笔(sketch)方式.
  13.    C-框选:  框选实体边方式.
  14.      (按住Shift键延伸):同时按shift为延伸命令,而非剪切.
  15. |;

  16. (defun c:t (/ roop dis un cm os ed pr ss gr ga gb sel pt pt2 pts eg)

  17.   ;;定义自己的出错函数
  18.   (defun error (msg)      
  19.     (if  (and
  20.     (/= msg "console break")
  21.     (/= msg "Function cancelled")
  22.     (/= msg "quit/exit abort")
  23.   )
  24.       (progn
  25.   (error_end)
  26.   (princ "\n")
  27.   (princ "*取消*")
  28.       )
  29.     )
  30.   )

  31.   ;;定义自己的结尾恢复函数
  32.   (defun error_end ()
  33.     (if ss (redrawss ss 4 ))
  34.     (if  os (setvar "osmode" os))
  35.     (if  ed (setvar "edgemode" ed))
  36.     (if  pr (setvar "projmode" pr))
  37.     (setq *error* olderr)
  38.     (command "undo" "e")
  39.     (if  cm (setvar "cmdecho" cm))
  40.   )

  41.   ;;显示隐藏亮显消隐函数 1.显示图元 2. 隐藏图元(使其不可见) 3.亮显图元 4.取消亮显图元
  42.   (defun redrawss (ss mode)
  43.      (mapcar '(lambda (x) (redraw x mode))
  44.              (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS)))
  45.      )
  46.   (princ)
  47.   )

  48.   ;;取得grread跟踪点表,dis为控制精度的距离.
  49.   (defun getpts  (dis / gr pt pt0 pts)
  50.     (while (= 5 (car (setq gr (grread t 4 0))))
  51.       (setq pt (cadr gr))
  52.       (if (not pt0)
  53.   (setq pt0 pt
  54.         pts (cons pt0 pts)
  55.   )
  56.       )
  57.       (if (> (distance pt pt0) dis)
  58.   (progn
  59.     (grdraw pt pt0 1 1)
  60.     (setq  pts (cons pt pts)
  61.     pt0 pt
  62.     )
  63.   )
  64.       )
  65.     )
  66.     (redraw)
  67.     (reverse pts)
  68.   )

  69.   ;;开始主程序.
  70.   (command "undo" "be")
  71.   (princ
  72.      (strcat "\n当前设置:投影=" (nth (getvar "projmode") '("无" "UCS" "视图"))
  73.               ",边=" (nth (getvar "edgemode") '("不延伸" "延伸"))
  74.      )
  75.   )
  76.   (setq  olderr *error* *error* error)
  77.   (setq  roop T
  78.   dis  (* 0.01 (getvar "viewsize"))
  79.   un   0
  80.   )
  81.   (setq  cm (getvar "cmdecho")
  82.   os (getvar "osmode")
  83.   ed (getvar "edgemode")
  84.   pr (getvar "projmode")
  85.   )
  86.   (setvar "osmode" 0)
  87.   (setvar "cmdecho" 0)
  88.   (princ "\n选择对象或 <全部选择>: ")
  89.   (setq ss (ssget))
  90.   (if ss (redrawss ss 3 ))
  91.   (while roop
  92.     (princ
  93.       "\n选择要修剪的对象,或按住 Shift 键选择要延伸的对象,或 [栏选(F)/徒手选(S)/投影(P)/边(E)/重作(R)/放弃(U)]: "
  94.     )
  95.     (setq gr (grread nil 4 2)
  96.     ga (car gr)
  97.     gb (cadr gr)
  98.     )
  99.     (cond
  100.       ((= ga 3)
  101.        (cond
  102.    ;;点选.
  103.    ((setq sel (nentselp gb))
  104.     (command "_.trim")
  105.     (if ss
  106.       (progn
  107.               (redrawss ss 3)
  108.         (command ss)
  109.             )
  110.     )
  111.     (command "")
  112.     (command sel "")
  113.           (if ss (redrawss ss 3))
  114.    )
  115.    ;;框选.
  116.    (T
  117.       (if  (and (setq pt gb)
  118.          (setq pt2 (getcorner pt "指定对角点: "))
  119.     )
  120.         (progn
  121.     (setq pts (list  pt
  122.         (list (car pt) (cadr pt2))
  123.         pt2
  124.         (list (car pt2) (cadr pt))
  125.         )
  126.     )
  127.     (command "_.trim")
  128.     (if ss
  129.             (progn
  130.                   (redrawss ss 3)
  131.       (command ss)
  132.                   )
  133.     )
  134.     (command "")
  135.     (mapcar  '(lambda (x y) (command "f" x y ""))
  136.       pts
  137.       (cons (last pts) pts)
  138.     )
  139.     (command "")
  140.                 (if ss (redrawss ss 3))
  141.     (setq un (1+ un))
  142.         )
  143.       )
  144.    )
  145.        )
  146.       )
  147.       ;;放弃(U).
  148.       ((member gr '((2 117) (2 85)))
  149.        (if (> un 0)
  150.    (progn
  151.      (command "_.u")
  152.      (setq un (1- un))
  153.    )
  154.    (princ "\n没有操作可放弃")
  155.        )
  156.       )
  157.       ;;重作(R).
  158.       ((member gr '((2 114) (2 82)))
  159.        (setq un (1+ un))
  160.        (command "_.redo")
  161.       )
  162.       ;;边(E).
  163.       ((member gr '((2 101) (2 69)))
  164.        (progn
  165.        (initget 4)
  166.        (setq
  167.            XX (getint (strcat "\n输入隐含边延伸模式 [不延伸(0)/延伸(1)] <" (itoa (getvar "edgemode")) ">:" ) )
  168.        )
  169.        (if (or (= XX 0) (= XX 1))
  170.              (setvar "edgemode" XX)
  171.        )
  172.        )
  173.       )
  174.       ;;投影(P)
  175.       ((member gr '((2 112) (2 80)))
  176.        (progn
  177.        (initget 4)
  178.        (setq
  179.            XX (getint (strcat "\n输入投影选项 [无(0)/UCS(1)/视图(2)] <" (itoa (getvar "projmode"))  ">:"  ) )
  180.        )
  181.        (if (or (= XX 0) (= XX 1) (= XX 2))
  182.              (setvar "projmode" XX)
  183.        )
  184.        )
  185.       )
  186.       ;;徒手选(S).
  187.       ((member gr '((2 115) (2 83)))
  188.        (setq pts (getpts dis))
  189.        (if (setq pts2 (cdr pts))
  190.       (progn (command "_.trim")
  191.        (if ss            
  192.                      (progn
  193.                        (redrawss ss 3)
  194.            (command ss)
  195.                      )
  196.        )
  197.        (command "")
  198.        (mapcar '(lambda (x y) (command "f" x y "")) pts pts2)
  199.        (command "")
  200.                    (if ss (redrawss ss 3))
  201.       )
  202.        )
  203.       )
  204.       ;;栏选(F).
  205.       ((member gr '((2 102) (2 70)))
  206.        (setq pt (getpoint "\n第一栏选点: "))
  207.        (if (setq pt2 (getpoint pt "\n指定直线的端点: "))
  208.       (progn (command "_.trim")
  209.        (if ss            
  210.                      (progn
  211.                        (redrawss ss 3)
  212.            (command ss)
  213.                      )
  214.        )
  215.        (command "" "f" pt pt2 "")
  216.        (command "")
  217.                    (if ss (redrawss ss 3))
  218.       )
  219.        )
  220.       )
  221.       ;;空格或回车.
  222.       ((member gr '((11 0) (2 32)))
  223.        (setq roop nil)
  224.       )

  225.     )
  226.   )
  227.   (error_end)
  228.   (princ)
  229. )

 楼主| 发表于 2012-3-29 20:57 | 显示全部楼层
楼上的栏选只能两点!  右键不能退出(估计按我改得那样改改也能实现)!
块跟线一起选不能剪切! 块内单个线也不能选呢!

不过还是感谢你的参与! 看来喜欢CAD2004的还是有些人的! 呵呵
发表于 2012-3-30 11:22 | 显示全部楼层
xiaoyingzi 发表于 2012-3-29 20:37
我也发个最接近06版,可框选,可点选,可栏选,可徒手选的超级剪切,源码来自狂刀,自己调整了下使之比较接 ...

右键不能退出
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-3-29 12:57 , Processed in 0.239638 second(s), 36 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表