;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;幕匠LISP实验室;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;程序功能：窗剪ct   [备注：]
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(DEFUN C:ct ( / pt1 pt2 ent ent1 ent2 midpt i osm)
 (setvar "cmdecho" 0)
 (setq osm (getvar "osmode"))
  (setq pt2 (getpoint "select a point: "))
(setq pt1(getcorner pt2 "next pt"))
(setq ent1(ssget "w" pt1 pt2)) 
(command "erase" "w" pt1 pt2 "")
(setq ent2(ssget "f" (list
   pt2(list(car pt2)(cadr pt1))pt1(list(car pt1)(cadr pt2)) pt2 )))
(setq midpt(list(/ (+ (car pt1)(car pt2)) 2)(/ (+ (cadr pt1) (cadr pt2)) 2)))
(setq wid (getvar "plinewid"))
(setvar "plinewid" 0)
(setvar "osmode" 0)
(command "pline" pt2(list(car pt2)(cadr pt1))pt1(list(car pt1)(cadr pt2))"c")
(setvar "plinewid" wid)
(setq ent(entlast))
(if   ent2
  (progn
(setq i 0)
 (repeat (sslength ent2)
   (command "trim" ent "" (list (ssname ent2 i) midpt)  "" )
   (setq i (+ i 1))
 )
 ) ;;progn
 );;if
(entdel ent)
(setvar "osmode" osm)
(princ)
)