- 此函数如何添加修剪填充的功能呢 研究了半天无奈求助 感谢各位大侠
- ;★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 "" "")
- (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))
网友答: 参考了G版的帖子 但是TT函数 修剪时没法指定修剪的方向
;框内物体删除 By Gu_xl
(defun c:tt (/ OS P1 P2 CP SS ENREC N *error*)
(defun *error* (s)
(setvar "osmode" os)
(princ s)
)
(setq os (getvar "osmode"))
(setvar "osmode" 0)
(setq p1 (getpoint "\n指定基点："))
(setq p2 (getcorner p1 "\n指定对角点："))
(setq cp (mapcar '* '(0.5 0.5 0.5) (mapcar '+ p1 p2)))
(setq ss (ssget "w" p1 p2))
(if ss (command "erase" ss ""))
(command "rectang" p1 p2)
(setq enRec (entlast))
;;重复5次，以保证剪切干净
(repeat 5
(setq ss (ssget "c" p1 p2))
(ssdel enRec ss)
(command ".trim" enRec "")
(repeat (setq n (sslength ss))
(command (list (ssname ss (setq n (1- n))) cp))
)
(command "")
)
;;删除绘制的方框
(entdel enRec)
(setvar "osmode" os)
(princ)
)