这个lsp 能修剪框选内的对象 如何添加修剪填充功能
[*]此函数如何添加修剪填充的功能呢研究了半天无奈求助 感谢各位大侠
[*]
[*]
[*]
[*]
[*];★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)
)
页:
[1]