半听可乐 发表于 2012-11-29 14:02:14

开心版主的框选删除程序，麻烦加个选项

谁能帮帮我加一个“是否留矩形框”的选项，默认选项是不留
;---------------------------------------------------------------------------------------------------------------------
;★DB_KSDEL用矩形剪切矩形里的所有线条，留下矩形框
;by 马开金
;---------------------------------------------------------------------------------------------------------------------
(defun c:DB_KSDEL (/ p1 p2 p3 p4 dst ang p1a p2a p3a p4a lst)
   (PRINC "\n用矩形剪切矩形里的所有线条功能")
(cmdla0)
(setq p1 (getpoint "\n-->请点取矩形框的第一点：")
p2 (getcorner p1 "\n-->请点取矩形框的另一点：")
)
(setvar "osmode" 0)
(command "undo" "be")
(command "rectang" p1 p2)
(setq lst (entlast))
(setq p3 (list (car p2) (cadr p1))
p4 (list (car p1) (cadr p2))
dst (/ (distance p1 p2) 100.0)
ang (angle p1 p2)
p1a (polar p1 ang dst)
p2a (polar p2 ang (- 0 dst))
p3a (list (car p2a) (cadr p1a))
p4a (list (car p1a) (cadr p2a))
)
(command "_.trim" lst "" "f" p1a p3a p2a p4a p1a "" "")
(if (= txt5 "1")
(command "_erase" "all" "_r" "_c" p1 p2 "")
(command "_erase" "_w" p1 p2 "")
)
(command "rectang" p1 p2)
(command "undo" "e")
(cmdla1)
)
(defun CMDLA0 ()
(setq cmd (getvar "CMDECHO"))
(setq oom (getvar "orthomode"))
(setq osm (getvar "osmode"))
(setq hlt (getvar "highlight"))
(setq rmode (getvar "regenmode"))
(setvar "regenmode" 0)
(setvar "CMDECHO" 0)
(princ)
)
(defun CMDLA1 ()
(setvar "CMDECHO" cmd)
(setvar "orthomode" oom)
(setvar "osmode" osm)
(setvar "highlight" hlt)
(setvar "regenmode" rmode)
(PRINC "\n修剪完成")(PRINC))

革天明 发表于 2012-11-29 14:02:15

;;---------------------------------------------------------------------------------------------------------------------
;;★DB_KSDEL用矩形剪切矩形里的所有线条，留下矩形框
;;by 马开金
;;---------------------------------------------------------------------------------------------------------------------
(defun c:DB_KSDEL (/ p1 p2 p3 p4 dst ang p1a p2a p3a p4a lst)
   (PRINC "\n用矩形剪切矩形里的所有线条功能")
   (cmdla0)
   (setq        p1 (getpoint "\n-->请点取矩形框的第一点：")
        p2 (getcorner p1 "\n-->请点取矩形框的另一点：")
   )
   (setvar "osmode" 0)
   (command "undo" "be")
   (command "rectang" p1 p2)
   (setq lst (entlast))
   (setq        p3(list (car p2) (cadr p1))
        p4(list (car p1) (cadr p2))
        dst (/ (distance p1 p2) 100.0)
        ang (angle p1 p2)
        p1a (polar p1 ang dst)
        p2a (polar p2 ang (- 0 dst))
        p3a (list (car p2a) (cadr p1a))
        p4a (list (car p1a) (cadr p2a))
   )
   (command "_.trim" lst "" "f" p1a p3a p2a p4a p1a "" "")
   (if (= txt5 "1")
   (command "_erase" "all" "_r" "_c" p1 p2 "")
   (command "_erase" "_w" p1 p2 "")
   )
   (setq txt99 nil)
   (setq txt99 (getstring "\n请确认是否要保留矩形框?<不保留>"))
   (if (= "" txt99)
   (princ)
   (command "rectang" p1 p2)
   )
   (command "undo" "e")
   (cmdla1)
)
(defun CMDLA0 ()
   (setq cmd (getvar "CMDECHO"))
   (setq oom (getvar "orthomode"))
   (setq osm (getvar "osmode"))
   (setq hlt (getvar "highlight"))
   (setq rmode (getvar "regenmode"))
   (setvar "regenmode" 0)
   (setvar "CMDECHO" 0)
   (princ)
)
(defun CMDLA1 ()
   (setvar "CMDECHO" cmd)
   (setvar "orthomode" oom)
   (setvar "osmode" osm)
   (setvar "highlight" hlt)
   (setvar "regenmode" rmode)
   (PRINC "\n修剪完成")
   (PRINC)
)

革天明 发表于 2012-11-29 17:43:22

本帖最后由 革天明 于 2012-11-29 17:49 编辑

也就是你框选时的矩形框要保留？
;;---------------------------------------------------------------------------------------------------------------------
;;★DB_KSDEL用矩形剪切矩形里的所有线条，留下矩形框
;;by 马开金
;;---------------------------------------------------------------------------------------------------------------------
(defun c:DB_KSDEL (/ p1 p2 p3 p4 dst ang p1a p2a p3a p4a lst)
   (PRINC "\n用矩形剪切矩形里的所有线条功能")
   (cmdla0)
   (setq        p1 (getpoint "\n-->请点取矩形框的第一点：")
        p2 (getcorner p1 "\n-->请点取矩形框的另一点：")
   )
   (setvar "osmode" 0)
   (command "undo" "be")
   (command "rectang" p1 p2)
   (setq lst (entlast))
   (setq        p3(list (car p2) (cadr p1))
        p4(list (car p1) (cadr p2))
        dst (/ (distance p1 p2) 100.0)
        ang (angle p1 p2)
        p1a (polar p1 ang dst)
        p2a (polar p2 ang (- 0 dst))
        p3a (list (car p2a) (cadr p1a))
        p4a (list (car p1a) (cadr p2a))
   )
   (command "_.trim" lst "" "f" p1a p3a p2a p4a p1a "" "")
   (if (= txt5 "1")
   (command "_erase" "all" "_r" "_c" p1 p2 "")
   (command "_erase" "_w" p1 p2 "")
   )
(setq txt99 (getstring "\n请确认是否要保留矩形框?<空格为不保留>"))
   (if (= "" txt99)
   (princ)
   (command "rectang" p1 p2)
   )
   (command "undo" "e")
   (cmdla1)
)
(defun CMDLA0 ()
   (setq cmd (getvar "CMDECHO"))
   (setq oom (getvar "orthomode"))
   (setq osm (getvar "osmode"))
   (setq hlt (getvar "highlight"))
   (setq rmode (getvar "regenmode"))
   (setvar "regenmode" 0)
   (setvar "CMDECHO" 0)
   (princ)
)
(defun CMDLA1 ()
   (setvar "CMDECHO" cmd)
   (setvar "orthomode" oom)
   (setvar "osmode" osm)
   (setvar "highlight" hlt)
   (setvar "regenmode" rmode)
   (PRINC "\n修剪完成")
   (PRINC)
)

【KAIXIN】 发表于 2012-11-29 18:55:40

想不到这个功能还有用

半听可乐 发表于 2012-11-29 19:22:32

【KAIXIN】 发表于 2012-11-29 18:55 static/image/common/back.gif
想不到这个功能还有用

呵呵，挺好的功能，设备专业做联排管线标注时用得着

半听可乐 发表于 2012-11-29 19:27:32

革天明 发表于 2012-11-29 17:43 static/image/common/back.gif
也就是你框选时的矩形框要保留？
;;------------------------------------------------------------------ ...

革兄，现在程序运行成了不留框状态，我有时候希望保留矩形框，程序最好是默认不保留，通过按键“B”保留

kwok 发表于 2012-11-29 19:57:45

本帖最后由 kwok 于 2012-11-29 19:58 编辑

直接加y或n确定删或不删不更直观.默认y

半听可乐 发表于 2012-12-1 17:42:28

大侠好人做到底啊！

半听可乐 发表于 2012-12-3 11:12:10

革天明 发表于 2012-11-29 17:43 static/image/common/back.gif
也就是你框选时的矩形框要保留？
;;------------------------------------------------------------------ ...

非常感谢！

湜１只鱼 发表于 2012-12-3 15:48:48

呵呵   很好用正用上
页: [1] 2
查看完整版本: 开心版主的框选删除程序，麻烦加个选项