如何实现删除图框外的所有数据
1.画任意闭合多边形，多段线区域内的数据保存，多段线区域外的数据删除。2.多段线上的数据也要保留。
attach://91861.dwg
將源碼存成LSP
;
(DEFUN C:CT()
(SETQ largeExtentLine (CAR (ENTSEL "請選擇範圍線:")))
(IF largeExtentLine
(progn
(PRINC "\n請稍侯...")
(SETQ Old_LineType (GETVAR "PLINETYPE"))
(SETVAR "PLINETYPE" 2)(SETVAR "CMDECHO" 0)(SETVAR "OSMODE" 0)(SETVAR "CLAYER" "0")
(COMMAND "ZOOM" "E" "CONVERT" "P" "")
;;;;;由外範圍線得到外擴線的各節點的座標表及最大和最小座標
(SETQ newCoordnateList (GetListOfPline0 largeExtentLine))
;;(SETQ largeMaxMinBLTR (GetCoordnateOfBLTR0 newCoordnateList))
;;;;炸碎與已知多義線相交的圖塊和Region和Hatch
(EXPLODEBYFENCE0 newCoordnateList)
;;;;炸碎完畢
;;;;裁剪所有圖外實體
(SETQ SSout (TrimByFence0 newCoordnateList))
;;;;裁剪完畢
(COMMAND "zoom" "e" "PURGE" "A" "" "N" "PURGE" "A" "" "N")
(SETVAR "PLINETYPE" Old_LineType)
(SETVAR "CLAYER" "0")
(princ "\n裁切完畢!")(princ)
)
(progn
(princ "\n沒有選擇範圍線!!")(princ)
)
)
)
(DEFUN DeleteSetFromSet(firstSet secondSet / firstNum Setobjsequence)
(SETQ firstNum (SSLENGTH firstSet))
(SETQ Setobjsequence 0)
(REPEAT firstNum
(SSDEL (SSNAME firstSet Setobjsequence) secondSet)
(SETQ Setobjsequence (+ Setobjsequence 1))
)
(IF (> (SSLENGTH secondSet) 0)
(SETQ secondSet secondSet)
(SETQ secondSet NIL)
)
(SETQ secondSet secondSet)
)
(DEFUN GetLwPlineFromList(knownCoordList / newCoordList MainPline)
(SETVAR "PLINETYPE" 2)
(COMMAND "._PLINE")
(FOREACH newCoordList knownCoordList (COMMAND newCoordList))
(COMMAND "C")
(SETQ MainPline (ENTLAST))
)
(DEFUN GetListOfPline(EntityName / SSE_Pline Coordnate_Vertex LastList)
(SETQ SSE_Pline (ENTGET EntityName))
(SETQ LastList nil)
(IF (= (CDR (ASSOC 0 SSE_Pline)) "LWPOLYLINE")
(PROGN
(SETQ LastList (LIST (LIST 0 0)))
(SETQ N 0)
(WHILE (/= (NTH N SSE_PLINE) NIL)
(IF (= (CAR (NTH N SSE_PLINE)) 10)
(SETQ LastList (APPEND LastList (LIST (LIST (CADR (NTH N SSE_PLINE)) (CADDR (NTH N SSE_PLINE)))) ))
)
(SETQ N (+ N 1))
)
(SETQ LastList (CDR LastList))
)
)
(IF (= (CDR (ASSOC 0 SSE_Pline)) "POLYLINE")
(PROGN
(SETQ LastList (LIST (LIST 0 0)))
(SETQ newEntityName (ENTNEXT EntityName))
(WHILE (= (CDR (ASSOC 0 (ENTGET newEntityName))) "VERTEX")
(SETQ LastList (APPEND LastList (LIST (LIST (CADR (ASSOC 10 (ENTGET newEntityName))) (CADDR (ASSOC 10 (ENTGET newEntityName))) )) ))
(SETQ newEntityName (ENTNEXT newEntityName))
)
(SETQ LastList (CDR LastList))
)
)
(SETQ LastList LastList)
)
(DEFUN GetCoordnateOfBLTR(knownCoordList / CurrenPoint Xmin Ymin Xmax Ymax nowCoordnateList)
(SETQ nowCoordnateList knownCoordList)
(SETQ CurrenPoint (CAR nowCoordnateList)
Xmin (CAR CurrenPoint)
Ymin (CADR CurrenPoint)
Xmax (CAR CurrenPoint)
Ymax (CADR CurrenPoint))
(SETQ nowCoordnateList (CDR nowCoordnateList))
(WHILE (/= nowCoordnateList nil)
(SETQ CurrenPoint (CAR nowCoordnateList))
(IF (< (CAR CurrenPoint) Xmin) (SETQ Xmin (CAR CurrenPoint)))
(IF (< (CADR CurrenPoint) Ymin) (SETQ Ymin (CADR CurrenPoint)))
(IF (> (CAR CurrenPoint) Xmax) (SETQ Xmax (CAR CurrenPoint)))
(IF (> (CADR CurrenPoint) Ymax) (SETQ Ymax (CADR CurrenPoint)))
(SETQ nowCoordnateList (CDR nowCoordnateList))
)
(SETQ nowCoordnateList (LIST (LIST Xmin Ymin)(LIST Xmax Ymax)))
)
(DEFUN ExplodeByFence(knownCoordList)
(SETQ INSERT_SS (SSGET "F" (APPEND knownCoordList (LIST (NTH 0 knownCoordList))) (LIST (CONS 0 "INSERT")))) ;;將LwPolyline首尾相連append
(IF INSERT_SS
(PROGN
(SETQ NUMBER_INSERT (SSLENGTH INSERT_SS))
(SETQ NUM 0)
(REPEAT NUMBER_INSERT
(COMMAND "EXPLODE" (SSNAME INSERT_SS NUM))
(SETQ NUM (+ NUM 1))
)
)
)
)
(DEFUN ExplodeAllBLK()
(SETQ AllBLK (SSGET "X" (LIST (CONS 0 "INSERT"))))
(WHILE (/= AllBLK NIL)
(SETQ NumOfAllBLK (SSLENGTH AllBLK))
(SETQ BLKSequence 0)
(REPEAT NumOfAllBLK
(COMMAND "EXPLODE" (SSNAME AllBLK BLKSequence))
(SETQ BLKSequence (+ BLKSequence 1))
)
;;; (COMMAND "EXPLODE" AllBLK)
(SETQ AllBLK (SSGET "X" (LIST (CONS 0 "INSERT"))))
)
)
(DEFUN TrimByFence(knownCoordList / Count OFFSETDIST BoundaryLine newExtent newCoordList COORD objsequence)
(SETVAR "PLINETYPE" 2)
(SETQ Count 0)
(COMMAND "ZOOM" "E")
(REPEAT 21
(SETQ OFFSETDIST (- 2 (* 0.095 Count)))
(SETQ BoundaryLine (GetLwPlineFromList knownCoordList))
(COMMAND "OFFSET" OFFSETDIST BoundaryLine "-1000,-1000" "")
(SETQ newExtent (ENTLAST))
(SETQ newCoordList (GetListOfPline newExtent) )
(SETQ objsequence 0)
(SETQ COORD (NTH objsequence newCoordList))
(COMMAND "TRIM" BoundaryLine "" "F")
(WHILE COORD
(COMMAND COORD)
(SETQ objsequence (+ objsequence 1))
(SETQ COORD (NTH objsequence newCoordList))
)
(SETQ COORD (NTH 0 newCoordList))
(COMMAND COORD "" "" "ERASE" BoundaryLine newExtent "")
(SETQ Count (+ Count 1))
)
(SETQ p1 (nth 0 newcoordlist))
(SETQ newcoordlist (append newcoordlist (list p1)))
(SETQ ss-leave (ssget "F" newCoordList))
(IF ss-leave
(COMMAND "erase" ss-leave "")
)
)
(DEFUN GetListOfPline0(EntityName / SSE_Pline Coordnate_Vertex LastList)
(SETQ SSE_Pline (ENTGET EntityName))
(SETQ LastList nil)
(IF (= (CDR (ASSOC 0 SSE_Pline)) "LINE")
(PROGN
(setq p1 (cdr (assoc 10 sse_pline))
p2 (cdr (assoc 11 sse_pline)))
(setq p1 (reverse (cdr (reverse p1)))
p2 (reverse (cdr (reverse p2))))
(SETQ LastList (list p1 p2))
)
)
(IF (= (CDR (ASSOC 0 SSE_Pline)) "LWPOLYLINE")
(PROGN
(SETQ LastList (LIST (LIST 0 0)))
(SETQ N 0)
(WHILE (/= (NTH N SSE_PLINE) NIL)
(IF (= (CAR (NTH N SSE_PLINE)) 10)
(SETQ LastList (APPEND LastList (LIST (LIST (CADR (NTH N SSE_PLINE)) (CADDR (NTH N SSE_PLINE)))) ))
)
(SETQ N (+ N 1))
)
(SETQ LastList (CDR LastList))
)
)
(IF (= (CDR (ASSOC 0 SSE_Pline)) "POLYLINE")
(PROGN
(SETQ LastList (LIST (LIST 0 0)))
(SETQ newEntityName (ENTNEXT EntityName))
(WHILE (= (CDR (ASSOC 0 (ENTGET newEntityName))) "VERTEX")
(SETQ LastList (APPEND LastList (LIST (LIST (CADR (ASSOC 10 (ENTGET newEntityName))) (CADDR (ASSOC 10 (ENTGET newEntityName))) )) ))
(SETQ newEntityName (ENTNEXT newEntityName))
)
(SETQ LastList (CDR LastList))
)
)
(IF (= (CDR (ASSOC 0 SSE_Pline)) "ARC")
(PROGN
(SETQ LastList (LIST (LIST 0 0)))
(COMMAND "PEDIT" EntityName "Y" "" "CONVERT" "P" "S" (ENTLAST) "")
(SETQ SSE_Pline (ENTGET (ENTLAST)))
(SETQ N 0)
(WHILE (/= (NTH N SSE_PLINE) NIL)
(IF (= (CAR (NTH N SSE_PLINE)) 10)
(SETQ LastList (APPEND LastList (LIST (LIST (CADR (NTH N SSE_PLINE)) (CADDR (NTH N SSE_PLINE)))) ))
)
(SETQ N (+ N 1))
)
(SETQ LastList (CDR LastList))
(COMMAND "UNDO" 2)
))
(IF (= (CDR (ASSOC 0 SSE_Pline)) "CIRCLE")
(PROGN
(SETQ Ra1 (CDR (assoc 40 SSE_Pline)))
(SETQ P-Center (CDR (assoc 10 SSE_Pline)))
(SETQ P1 (POLAR P-Center 0 Ra1))
(SETQ P2 (POLAR P-Center (* PI 0.5) Ra1))
(SETQ P3 (POLAR P-Center (* PI 1.0) Ra1))
(SETQ P4 (POLAR P-Center (* PI 1.5) Ra1))
(SETQ LastList (LIST P1 P2 P3 P4))
))
(SETQ LastList LastList)
)
(DEFUN ExplodeAllBLK0()
(SETQ AllBLK (SSGET "X" (LIST (CONS 0 "INSERT"))))
(WHILE (/= AllBLK NIL)
(SETQ NumOfAllBLK (SSLENGTH AllBLK))
(SETQ BLKSequence 0)
(REPEAT NumOfAllBLK
(COMMAND "EXPLODE" (SSNAME AllBLK BLKSequence))
(SETQ BLKSequence (+ BLKSequence 1))
)
;;; (COMMAND "EXPLODE" AllBLK)
(SETQ AllBLK (SSGET "X" (LIST (CONS 0 "INSERT"))))
)
)
(DEFUN TrimByFence0(knownCoordList / Count OFFSETDIST BoundaryLine newExtent newCoordList COORD objsequence)
(SETVAR "PLINETYPE" 2)
(SETQ Count 0)
(COMMAND "ZOOM" "E")
(REPEAT 21
(SETQ OFFSETDIST (- 2 (* 0.095 Count)))
(SETQ BoundaryLine (GetLwPlineFromList0 knownCoordList))
(COMMAND "OFFSET" OFFSETDIST BoundaryLine "-1000,-1000" "")
(SETQ newExtent (ENTLAST))
(SETQ newCoordList (GetListOfPline0 newExtent) )
(SETQ objsequence 0)
(SETQ COORD (NTH objsequence newCoordList))
(COMMAND "TRIM" BoundaryLine "" "F")
(WHILE COORD
(COMMAND COORD)
(SETQ objsequence (+ objsequence 1))
(SETQ COORD (NTH objsequence newCoordList))
)
(SETQ COORD (NTH 0 newCoordList))
(COMMAND COORD "" "" "ERASE" BoundaryLine newExtent "")
(SETQ Count (+ Count 1))
)
(SETQ Count 0)
(REPEAT 10
(SETQ OFFSETDIST (- 0.1 (* 0.01 Count)))
(SETQ BoundaryLine (GetLwPlineFromList0 knownCoordList))
(COMMAND "OFFSET" OFFSETDIST BoundaryLine "-1000,-1000" "")
(SETQ newExtent (ENTLAST))
(SETQ newCoordList (GetListOfPline0 newExtent) )
(SETQ objsequence 0)
(SETQ COORD (NTH objsequence newCoordList))
(COMMAND "TRIM" BoundaryLine "" "F")
(WHILE COORD
(COMMAND COORD)
(SETQ objsequence (+ objsequence 1))
(SETQ COORD (NTH objsequence newCoordList))
)
(SETQ COORD (NTH 0 newCoordList))
(COMMAND COORD "" "" )
(COMMAND "ERASE" BoundaryLine newExtent "")
(SETQ Count (+ Count 1))
)
(setq CenterSeg (GetCoordnateOfBLTR0 knownCoordList))
(setq point-BL (car CenterSeg)
point-TR (cadr CenterSeg))
(setq Xmax (car point-TR)
Ymax (cadr point-TR)
Xmin (car point-BL)
Ymin (cadr point-BL))
(setq point-Center (list (/ (+ (car point-BL) (car point-TR)) 2) (/ (+ (cadr point-BL) (cadr point-TR)) 2)))
(SETQ BoundaryLine (GetLwPlineFromList0 knownCoordList))
(COMMAND "OFFSET" "0.01" BoundaryLine point-Center "")
(SETQ newExtent (ENTLAST))
(setq In-CoordList (GetListOfPline0 (ENTLAST)))
(COMMAND "ERASE" BoundaryLine newExtent "")
(setq p1 (nth 0 newcoordlist))
(setq newcoordlist (append newcoordlist (list p1)))
;;;;ss-Wider為寬度大於0的線
(setq ss-Wider (ssget "F" newCoordList
'((-4 . "<or")
(-4 . "<and")
(-4 . "<or")
(0 . "LINE")(0 . "POLYLINE")(0 . "LWPOLYLINE")
(-4 . "or>")
(-4 . "<or")
(-4 . ">")(40 . 0.0)(-4 . ">")(41 . 0.0)
(-4 . "or>")
(-4 . "and>")
(-4 . "or>"))
))
(setq Num-Wider 0) ;;;;;Num-Wider為寬度大於0的線段
(if ss-Wider
(progn
(setq i 0)
(setq Num-Wider (sslength ss-Wider))
(repeat Num-Wider
(setq ss-every (ssname ss-Wider i))
(setq sse-every (entget ss-every))
(command "pedit" ss-every "w" "0" "")
(setq i (+ i 1))
)
)
)
(setq ss-must-delete (ssget "F" newCoordList
'((-4 . "<or")
(0 . "LINE")(0 . "LWPOLYLINE")(0 . "POLYLINE")(0 . "ARC")(0 . "CIRCLE")
(-4 . "or>"))
))
(setq ss-must-keep nil)
(SETQ ss-must-keep (SSGET "CP" In-CoordList))
(if (= ss-must-keep nil)
(setq ss-must-keep (ssadd))
)
(if (> Num-Wider 0)
(command "undo" Num-Wider)
)
(if ss-must-delete
(command "erase" ss-must-delete "r" ss-must-keep "")
)
(SETQ SS1 (SSGET "CP" knownCoordList)) ;;;;;;ss1為所有範圍內實體
(IF (= SS1 nil)
(COMMAND "ERASE" "all" "")
(COMMAND "ERASE" "all" "R" SS1 "")
)
;;;;刪除完畢
***********************************************************************************
)
(DEFUN ExplodeByFence0(knownCoordList)
(SETQ INSERT_SS (SSGET "F" (APPEND knownCoordList (LIST (NTH 0 knownCoordList)))
'((-4 . "<or")
(0 . "INSERT")
(0 . "HATCH")
(0 . "REGION")
(-4 . "or>"))
));;;
(IF INSERT_SS
(PROGN
(SETQ NUMBER_INSERT (SSLENGTH INSERT_SS))
(SETQ NUM 0)
(REPEAT NUMBER_INSERT
(COMMAND "EXPLODE" (SSNAME INSERT_SS NUM))
(SETQ NUM (+ NUM 1))
)
)
)
)
(DEFUN GetLwPlineFromList0(knownCoordList / newCoordList MainPline)
(SETVAR "PLINETYPE" 2)
(COMMAND "._PLINE")
(FOREACH newCoordList knownCoordList (COMMAND newCoordList))
(COMMAND "C")
(SETQ MainPline (ENTLAST))
)
(DEFUN GetCoordnateOfBLTR0(knownCoordList / CurrenPoint Xmin Ymin Xmax Ymax nowCoordnateList)
(SETQ nowCoordnateList knownCoordList)
(SETQ CurrenPoint (CAR nowCoordnateList)
Xmin (CAR CurrenPoint)
Ymin (CADR CurrenPoint)
Xmax (CAR CurrenPoint)
Ymax (CADR CurrenPoint))
(SETQ nowCoordnateList (CDR nowCoordnateList))
(WHILE (/= nowCoordnateList nil)
(SETQ CurrenPoint (CAR nowCoordnateList))
(IF (< (CAR CurrenPoint) Xmin) (SETQ Xmin (CAR CurrenPoint)))
(IF (< (CADR CurrenPoint) Ymin) (SETQ Ymin (CADR CurrenPoint)))
(IF (> (CAR CurrenPoint) Xmax) (SETQ Xmax (CAR CurrenPoint)))
(IF (> (CADR CurrenPoint) Ymax) (SETQ Ymax (CADR CurrenPoint)))
(SETQ nowCoordnateList (CDR nowCoordnateList))
)
(SETQ nowCoordnateList (LIST (LIST Xmin Ymin)(LIST Xmax Ymax)))
)
song宋_74729 发表于 2016-1-24 16:38 static/image/common/back.gif
將源碼存成LSP
;
(DEFUN C:CT()
谢谢分享，提供了很多实用的函数，学习了 谢谢song宋_74729分享！ xuexi! 这个实用！流个记号，下次备用。 这种重线的裁剪不了 望补充 請問大哥有展點類似這圖lsp源碼嗎
页:
[1]