明经CAD社区

 找回密码
 注册

扫一扫,访问微社区

QQ登录

只需一步,快速开始

查看: 2271|回复: 14

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

  [复制链接]
发表于 2012-11-29 14:02 | 显示全部楼层 |阅读模式
1明经币
谁能帮帮我加一个“是否留矩形框”的选项,默认选项是不留
;---------------------------------------------------------------------------------------------------------------------
;★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))

最佳答案

查看完整内容

;;--------------------------------------------------------------------------------------------------------------------- ;;★DB_KSDEL 用矩形剪切矩形里的所有线条,留下矩形框 ;;by 马开金 ;;--------------------------------------------------------------------------------------------------------------------- (defun cB_KSDEL (/ p1 p2 p3 p4 dst ang p1a p2a p3a p4a lst) (PRINC "\n用矩形剪切 ...
发表于 2012-11-29 14:02 | 显示全部楼层
;;---------------------------------------------------------------------------------------------------------------------
;;★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 | 显示全部楼层
本帖最后由 革天明 于 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)
)

回复

使用道具 举报

发表于 2012-11-29 18:55 | 显示全部楼层
想不到这个功能还有用
回复

使用道具 举报

 楼主| 发表于 2012-11-29 19:22 | 显示全部楼层
【KAIXIN】 发表于 2012-11-29 18:55
想不到这个功能还有用

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

使用道具 举报

 楼主| 发表于 2012-11-29 19:27 | 显示全部楼层
革天明 发表于 2012-11-29 17:43
也就是你框选时的矩形框要保留?
;;------------------------------------------------------------------ ...

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

使用道具 举报

发表于 2012-11-29 19:57 | 显示全部楼层
本帖最后由 kwok 于 2012-11-29 19:58 编辑

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

点评

上一个点评错了,不用作任何更改,,,,革天明 加的那段是任意键保留,直接确认不保留  发表于 2012-11-30 13:07
默认不保留,任意键保留 (setq txt99 nil) (setq txt99 (getstring "\n请确认是否要保留矩形框?<不保留>")) (if (/= "" txt99) (princ) (command "rectang" p1 p2) )   发表于 2012-11-30 12:55
对,这提示更有国际范  发表于 2012-11-29 20:00
回复

使用道具 举报

 楼主| 发表于 2012-12-1 17:42 来自手机 | 显示全部楼层
大侠好人做到底啊!

点评

这样的小改动你都弄不好吗?因为LISP完全是订制化的,自己写的才是最好的,这个功能很简单,如果你不会只能说明你的金牌会员太水了  发表于 2012-12-3 10:00
回复

使用道具 举报

 楼主| 发表于 2012-12-3 11:12 | 显示全部楼层
革天明 发表于 2012-11-29 17:43
也就是你框选时的矩形框要保留?
;;------------------------------------------------------------------ ...

非常感谢!
回复

使用道具 举报

发表于 2012-12-3 15:48 | 显示全部楼层
呵呵   很好用  正用上
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2018-4-20 05:25 , Processed in 0.277306 second(s), 33 queries , Gzip On.

Powered by Discuz! X3.3

© 2001-2013 Comsenz Inc.

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