这个lsp 能修剪框选内的对象 如何添加修剪填充功能

LXH

• 此函数如何添加修剪填充的功能呢  研究了半天无奈求助   感谢各位大侠
• 
  
• 
  
• 
  
• 
  
• ;★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))
  

LXH

参考了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)
   )