[原创]：别开生面的TRIM第三版

lijiao · 发表于 2005-3-30 17:44:45

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

已经达到实用状态：
命令：XX
功能：右击：切换剪切与延伸
   Shift＋右击：选择边界
   左击：选择操作实体
   回车：退出程序

[FONT=courier new]
(defun c:xx (/ FANGSHI LOOP LOOP1 PT PT0 PTLIST PTLIST0 SIZE SS SS0)
;;; (myerr)
;;; (varset "cmdecho" 0)
;;; (varset "osmode" 0)
(setq loop t
fangshi t
ss0 nil
)
(princ "\n右击：切换剪切与延伸／ Shift＋右击：选择边界／左击：选择操作实体／回车：退出程序")
(while loop
(setq pt (grread t 4 1))
(cond
((= 3 (car pt))
(setq ptlist (list (cadr pt)))
(setq loop1 t)
(while loop1
(setq pt (grread t 4 1))
(cond
((= 3 (car pt))
(setq ptlist (cons (cadr pt) ptlist))
(setq loop1 nil)
)
((= 5 (car pt))
(setq size (* (getvar "viewsize") 0.05))
(redraw)
(guangbiao fangshi size (cadr pt))
(setq pt0 (cadr pt))
(if (> (length ptlist) 0)
(foreach pt1 ptlist
(grdraw pt0 (setq pt0 pt1) 1)
)
)
(if (> (distance (cadr pt) (car ptlist)) (* 0.5 size))
(setq ptlist (cons (cadr pt) ptlist))
)
)
((= 25 (car pt))
(setq fangshi (not fangshi)
ss0 nil
)
)
((and (= 11 (car pt))
(= 1000 (cadr pt))
)
(if ss0 (cs_redraw ss0 4))
(setq ss0 (ssget))
(setq loop1 nil)
)
((= 2 (car pt))
(if (or (= (cadr pt) 32)
(= (cadr pt) 13)
)
(setq loop nil
loop1 nil
)
)
)
)
)
(setq ptlist (reverse ptlist))
(setq pt (car ptlist)
ptlist0 (cdr ptlist)
)
(if fangshi
(if ss0
(command "trim" ss0 "")
(command "trim" "")
)
(if ss0
(command "EXTEND" ss0 "")
(command "EXTEND" "")
)
)
(foreach pt0 ptlist0
(if (setq ss (ssget "f" (list pt pt0)))
(command "f" pt pt0 "")
)
(setq pt pt0)
)
(command "")
(if (and fangshi
(not ss0)
(setq ss (ssget "f" ptlist))
)
(command "erase" ss "")
)
(princ "\n右击：切换剪切与延伸／ Shift＋右击：选择边界／左击：选择操作实体／回车：退出程序")
)
((= 5 (car pt))
(setq size (* (getvar "viewsize") 0.05))
(redraw)
(guangbiao fangshi size (cadr pt))
)
((= 25 (car pt))
(setq fangshi (not fangshi)
ss0 nil
)
)
((and (= 11 (car pt))
(= 1000 (cadr pt))
)
(if ss0 (cs_redraw ss0 4))
(setq ss0 (ssget))
)
((= 2 (car pt))
(cond
((or (= (cadr pt) 32)
(= (cadr pt) 13)
)
(setq loop nil)
)
)
)
)
)
(if ss0 (cs_redraw ss0 4))
(redraw)
;;; (restore)
(princ)
)
(defun guangbiao (fangshi size pt0 /)
(if fangshi
(progn
(grdraw (polar pt0 (dtor 15) size)
(setq pt1 (polar pt0 (dtor -165) size))
7
)
(grdraw pt1
(setq pt1 (polar pt1 (dtor -90) (* 0.5 size)))
7
)
(grdraw pt1
(setq pt1 (polar pt0 (dtor -90) (* 0.5 size)))
7
)
(grdraw pt1 pt0 7)
(grdraw (polar pt0 (dtor -15) size)
(setq pt1 (polar pt0 (dtor 165) size))
7
)
(grdraw pt1 (setq pt1 (polar pt1 (dtor 90) (* 0.5 size))) 7)
(grdraw pt1 (setq pt1 (polar pt0 (dtor 90) (* 0.5 size))) 7)
(grdraw pt1 pt0 7)
)
(progn
(grdraw pt0 (polar pt0 (dtor 135) size) 7)
(grdraw pt0 (polar pt0 (dtor -135) size) 7)
(grdraw pt0 (polar pt0 (dtor 180) (* size 1.5)) 7)
)
)
)
(defun cs_redraw (ss mod / )
(foreach ss0 (ss->list ss)
(redraw ss0 mod)
)
)
(defun ss->list (ss / cs_i out)
(if (= (type ss) 'PICKSET)
(progn
(setq cs_i 0
out '()
)
(repeat (sslength ss)
(setq out (cons (ssname ss cs_i) out))
(setq cs_i (1+ cs_i))
)
(setq out (reverse out))
)
)
)
[/FONT]

[FONT=courier new] 
(defun c:xx (/ FANGSHI LOOP LOOP1 PT PT0 PTLIST PTLIST0 SIZE SS SS0) 
;;;  (myerr) 
;;;  (varset "cmdecho" 0) 
;;;  (varset "osmode" 0) 
  (setq        loop t 
        fangshi        t 
        ss0 nil 
  ) 
  (princ "\n右击：切换剪切与延伸／ Shift＋右击：选择边界／左击：选择操作实体／回车：退出程序") 
  (while loop 
    (setq pt (grread t 4 1)) 
    (cond 
      ((= 3 (car pt)) 
       (setq ptlist (list (cadr pt))) 
       (setq loop1 t) 
       (while loop1 
         (setq pt (grread t 4 1)) 
         (cond 
           ((= 3 (car pt)) 
            (setq ptlist (cons (cadr pt) ptlist)) 
            (setq loop1 nil) 
           ) 
           ((= 5 (car pt)) 
            (setq size (* (getvar "viewsize") 0.05)) 
            (redraw) 
            (guangbiao fangshi size (cadr pt)) 
            (setq pt0 (cadr pt)) 
            (if        (> (length ptlist) 0) 
              (foreach pt1 ptlist 
                (grdraw pt0 (setq pt0 pt1) 1) 
              ) 
            ) 
            (if        (> (distance (cadr pt) (car ptlist)) (* 0.5 size)) 
              (setq ptlist (cons (cadr pt) ptlist)) 
            ) 
           ) 
           ((= 25 (car pt)) 
            (setq fangshi (not fangshi) 
                  ss0          nil 
            ) 
           ) 
           ((and (= 11 (car pt)) 
                 (= 1000 (cadr pt)) 
            ) 
            (if ss0 (cs_redraw ss0 4)) 
            (setq ss0 (ssget)) 
            (setq loop1 nil) 
           ) 
           ((= 2 (car pt)) 
            (if        (or (= (cadr pt) 32) 
                    (= (cadr pt) 13) 
                ) 
              (setq loop nil 
                    loop1 nil 
              ) 
            ) 
           ) 
         ) 
       ) 
       (setq ptlist (reverse ptlist)) 
       (setq pt             (car ptlist) 
             ptlist0 (cdr ptlist) 
       ) 
       (if fangshi 
         (if ss0 
           (command "trim" ss0 "") 
           (command "trim" "") 
         ) 
         (if ss0 
           (command "EXTEND" ss0 "") 
           (command "EXTEND" "") 
         ) 
       ) 
       (foreach        pt0 ptlist0 
         (if (setq ss (ssget "f" (list pt pt0))) 
           (command "f" pt pt0 "") 
         ) 
         (setq pt pt0) 
       ) 
       (command "") 
       (if (and        fangshi 
                (not ss0) 
                (setq ss (ssget "f" ptlist)) 
           ) 
         (command "erase" ss "") 
       ) 
       (princ "\n右击：切换剪切与延伸／ Shift＋右击：选择边界／左击：选择操作实体／回车：退出程序") 
      ) 
      ((= 5 (car pt)) 
       (setq size (* (getvar "viewsize") 0.05)) 
       (redraw) 
       (guangbiao fangshi size (cadr pt)) 
      ) 
      ((= 25 (car pt)) 
       (setq fangshi (not fangshi) 
             ss0     nil 
       ) 
      ) 
      ((and (= 11 (car pt)) 
            (= 1000 (cadr pt)) 
       ) 
       (if ss0 (cs_redraw ss0 4)) 
       (setq ss0 (ssget)) 
      ) 
      ((= 2 (car pt)) 
       (cond 
         ((or (= (cadr pt) 32) 
              (= (cadr pt) 13) 
          ) 
          (setq loop nil) 
         ) 
       ) 
      ) 
    ) 
  ) 
  (if ss0 (cs_redraw ss0 4)) 
  (redraw) 
;;;  (restore) 
  (princ) 
) 
(defun guangbiao (fangshi size pt0 /) 
  (if fangshi 
    (progn 
      (grdraw (polar pt0 (dtor 15) size) 
              (setq pt1 (polar pt0 (dtor -165) size)) 
              7 
      ) 
      (grdraw pt1 
              (setq pt1 (polar pt1 (dtor -90) (* 0.5 size))) 
              7 
      ) 
      (grdraw pt1 
              (setq pt1 (polar pt0 (dtor -90) (* 0.5 size))) 
              7 
      ) 
      (grdraw pt1 pt0 7) 
      (grdraw (polar pt0 (dtor -15) size) 
              (setq pt1 (polar pt0 (dtor 165) size)) 
              7 
      ) 
      (grdraw pt1 (setq pt1 (polar pt1 (dtor 90) (* 0.5 size))) 7) 
      (grdraw pt1 (setq pt1 (polar pt0 (dtor 90) (* 0.5 size))) 7) 
      (grdraw pt1 pt0 7) 
    ) 
    (progn 
      (grdraw pt0 (polar pt0 (dtor 135) size) 7) 
      (grdraw pt0 (polar pt0 (dtor -135) size) 7) 
      (grdraw pt0 (polar pt0 (dtor 180) (* size 1.5)) 7) 
    ) 
  ) 
) 
(defun cs_redraw (ss mod / ) 
  (foreach ss0 (ss->list ss) 
    (redraw ss0 mod) 
    ) 
  ) 
(defun ss->list         (ss / cs_i out) 
  (if (= (type ss) 'PICKSET) 
    (progn 
      (setq cs_i 0 
            out         '() 
            ) 
      (repeat (sslength ss) 
        (setq out (cons (ssname ss cs_i) out)) 
        (setq cs_i (1+ cs_i)) 
        ) 
      (setq out (reverse out)) 
      ) 
    ) 
  ) 
  [/FONT]

xyp1964 · 发表于 2005-3-30 17:52:22

好好的TRIM，弄得有点复杂！
不过创意很好，可以学学斑竹grread函数的应用。

狂刀 · 发表于 2005-3-30 23:21:38

不用写那么长。
修改by狂刀

(defun c:xx (/ cmde os ocs roop dis ss gr ga gb sel pt pt2 pts eg cmd)
(princ "\n自由剪切－－－修改by狂刀.2005.3")
(setq cmde (getvar "cmdecho")
os (getvar "osmode")
roop T
dis (* 0.01 (getvar "viewsize"))
cmd ".trim"
)
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(setq ss (ssget "all"))
(while roop
(princ "\n shift+右键＝选边界 / 右键＝切换剪切延伸模式 / 左键＝选实体 / 空格;回车＝退出:")
(setq gr (grread nil 4 2)
ga (car gr)
gb (cadr gr))
(cond
((= ga 3)
(princ "\n选剪切实体:")
(cond
((setq sel (nentselp gb))(command cmd ss "" sel ""));;单选.
(T (setq pts (getpts dis))
(if (setq pts2(cdr pts))
(progn (command cmd ss "")
(mapcar '(lambda(x y)(command "f" x y "")) pts pts2)
(command "")
)
)
)
)
)
((member gr '((11 0)(2 32))) ;; "" or enter
(setq roop nil))
((= 25 ga)(if (= cmd ".trim") ;;切换.
(progn (princ "\n 模式: 延伸\n选实体:")(setq cmd ".extend"))
(progn (princ "\n 模式: 剪切\n选实体:")(setq cmd ".trim"))
)
)
((member gr '((11 1000)))
(princ "\n 重选边界< all > :")
(or(setq ss (ssget))(setq ss (ssget "all"))))
)
)
(setvar "cmdecho" cmde)
(setvar "osmode" os)
(setq *error* oe)
(princ)
)
(defun getpts (dis / gr pt pt0 pts)
(setq ocs (getvar "CURSORSIZE"))
(setvar "CURSORSIZE" 1)
(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)
(setvar "CURSORSIZE" ocs)
(reverse pts)
)

(defun c:xx (/ cmde os ocs roop dis ss gr ga gb sel pt pt2 pts eg cmd) 
  (princ "\n自由剪切－－－修改by狂刀.2005.3") 
  (setq        cmde  (getvar "cmdecho") 
        os   (getvar "osmode") 
        roop T 
        dis  (* 0.01 (getvar "viewsize")) 
        cmd ".trim" 
  ) 
  (setvar "cmdecho" 0) 
  (setvar "osmode" 0) 
  (setq ss (ssget "all")) 
  (while roop 
    (princ "\n shift+右键＝选边界 / 右键＝切换剪切延伸模式 / 左键＝选实体 / 空格;回车＝退出:") 
    (setq gr (grread nil 4 2) 
          ga (car gr) 
          gb (cadr gr)) 
    (cond 
      ((= ga 3) 
       (princ "\n选剪切实体:") 
       (cond 
         ((setq sel (nentselp gb))(command cmd ss "" sel ""));;单选. 
         (T (setq pts (getpts dis)) 
          (if (setq pts2(cdr pts)) 
            (progn (command cmd ss "") 
              (mapcar '(lambda(x y)(command "f" x y "")) pts pts2) 
              (command "") 
            ) 
           ) 
          ) 
       ) 
      ) 
      ((member gr '((11 0)(2 32))) ;; "" or enter 
        (setq roop nil)) 
      ((= 25 ga)(if (= cmd ".trim") ;;切换. 
         (progn (princ "\n 模式: 延伸\n选实体:")(setq cmd ".extend")) 
        (progn (princ "\n 模式: 剪切\n选实体:")(setq cmd ".trim")) 
        ) 
      ) 
      ((member gr '((11 1000))) 
       (princ "\n 重选边界< all > :") 
       (or(setq ss (ssget))(setq ss  (ssget "all")))) 
   ) 
  ) 
  (setvar "cmdecho" cmde) 
  (setvar "osmode" os) 
  (setq *error* oe) 
  (princ) 
) 
(defun getpts (dis / gr pt pt0 pts) 
   (setq ocs (getvar "CURSORSIZE")) 
   (setvar "CURSORSIZE" 1) 
   (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) 
  (setvar "CURSORSIZE" ocs) 
  (reverse pts) 
)

啵浪鼓 · 发表于 2005-3-30 23:59:29

狂刀的程序OK

斑竹的命令提示错误:
Command: xx
右击：切换剪切与延伸／
Shift＋右击：选择边界／左击：选择操作实体／回车：退出程序; error: no function
definition: DTOR

狂刀 · 发表于 2005-3-31 07:33:40

试帮楼主补上dtor,不知道对否:)
(defun dtor (d)
(* PI (/ d 180))
)

ljpnb · 发表于 2005-3-31 07:52:19

最初由狂刀发布
[B]试帮楼主补上dtor,不知道对否:)
(defun dtor (d)
(* PI (/ d 180))
) [/B]

确实少了这句，狂刀的程序改得不错，挺好用的，不过还有点不太习惯

pdzhj · 发表于 2005-4-18 18:56:05

狂刀的程序很好
不过可不可以再增加一些功能，我经常要在一张大图上（如道路平面图）选取一小快图形，并将选取图形以外的图形删除，我现在是这样做的：在一张大图上先画一个矩形，然后选这个矩形为剪切边界，将矩形以外的线剪切掉，再将矩形以外的所有图形全部删除，只剩下矩形筐内的图形。能否加一个这样的功能，使筐选的图形保留，而筐选以外的图形删除。

狂刀 · 发表于 2005-4-19 12:56:59

论坛上有，自己搜索
ａｅｏ，ｓｎｓｊ做过

wangjiancctv · 发表于 2006-4-8 21:23:48

真多高手呀

dwg001 · 发表于 2006-4-9 17:03:32

“狂刀”好锋利，向你学习。

ENGNIEER · 发表于 2006-4-11 17:08:07

速度有点慢，为什么？的确方便了好多

lin51050 · 发表于 2006-4-11 20:32:17

挺好的

xkcjf_1219 · 发表于 2006-4-15 20:49:12

狂刀——真正锋利的剪刀也！

apsmould · 发表于 2006-4-17 09:23:11

好东西

zzqxuexicad · 发表于 2006-4-17 11:05:06

错误: no function definition: DTOR

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

[原创]：别开生面的TRIM第三版

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子