如何实现删除图框外的所有数据

lxb9721

1.画任意闭合多边形，多段线区域内的数据保存，多段线区域外的数据删除。

2.多段线上的数据也要保留。


http://bbs.mjtd.com/forum.php?mod=attachment&aid=OTE4NjF8NTljMDgyZjBiNWUyMzI0ZWJjYjkyNzhkOTI5YTIzMGV8MTc0Nzc0NDAyNA%3D%3D&request=yes&_f=.dwg

song宋_74729

將源碼存成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
將源碼存成LSP
;
(DEFUN C:CT()

谢谢分享，提供了很多实用的函数，学习了

mycad

谢谢song宋_74729分享！

mycad

xuexi!

chenbh2

这个实用！流个记号，下次备用。

知者无疆

知者无疆

这种重线的裁剪不了 望补充

song宋_74729

請問大哥有展點類似這圖lsp源碼嗎