(DEFUN C:EXTRIM (/ NA E1 P1 REDRAW_IT LST N) (ACET-ERROR-INIT (LIST (LIST "cmdecho" 0 "highlight" 0 "regenmode" 1 "osmode" 0 "ucsicon" 0 "offsetdist" 0 "attreq" 0 "plinewid" 0 "plinetype" 1 "gridmode" 0 "celtype" "CONTINUOUS" "ucsfollow" 0 "limcheck" 0) T (QUOTE (IF REDRAW_IT (REDRAW NA 4))))) (PRINC "\n拾取多段线、直线、圆、圆弧、椭圆、图像或文字来剪切边界...") (SETQ NA (ACET-UI-SINGLE-SELECT (QUOTE ((-4 . "<OR") (0 . "CIRCLE") (0 . "ARC") (0 . "LINE") (0 . "ELLIPSE") (0 . "ATTDEF") (0 . "TEXT") (0 . "MTEXT") (0 . "IMAGE") (0 . "SPLINE") (0 . "INSERT") (0 . "SOLID") (0 . "3DFACE") (0 . "TRACE") (0 . "LWPOLYLINE") (-4 . "<AND") (0 . "POLYLINE") (-4 . "<NOT") (-4 . "&") (70 . 112) (-4 . "NOT>") (-4 . "AND>") (-4 . "OR>"))) T)) (IF NA (PROGN (SETQ E1 (ENTGET NA)) (IF (OR (EQUAL "TEXT" (CDR (ASSOC 0 E1))) (EQUAL "MTEXT" (CDR (ASSOC 0 E1))) (EQUAL "ATTDEF" (CDR (ASSOC 0 E1))) (EQUAL "IMAGE" (CDR (ASSOC 0 E1))) (EQUAL "INSERT" (CDR (ASSOC 0 E1))) (EQUAL "SOLID" (CDR (ASSOC 0 E1))) (EQUAL "3DFACE" (CDR (ASSOC 0 E1))) (EQUAL "TRACE" (CDR (ASSOC 0 E1)))) (PROGN (SETQ LST (ACET-GEOM-OBJECT-POINT-LIST NA nil)) (SETQ N 0) (COMMAND "_.pline") (REPEAT (LENGTH LST) (COMMAND (NTH N LST)) (SETQ N (+ N 1))) (IF (NOT (EQUAL (CAR LST) (LAST LST) 1.0e-007)) (COMMAND "_cl") (COMMAND "")) (SETQ NA (ENTLAST) E1 NA)) (SETQ E1 nil)) (REDRAW NA 3) (SETQ REDRAW_IT T) (SETQ P1 (GETPOINT "\n指定要修剪的一侧:")) (REDRAW NA 4) (SETQ REDRAW_IT nil) (IF P1 (ETRIM NA P1)) (IF E1 (PROGN (IF (SETQ P1 (ACET-LAYER-LOCKED (GETVAR "clayer"))) (COMMAND "_.layer" "_un" (GETVAR "clayer") "")) (ENTDEL E1) (IF P1 (COMMAND "_.layer" "_lock" (GETVAR "clayer") "")))))) (ACET-ERROR-RESTORE) (PRINC))
(DEFUN ETRIM (NA A / LA B D E1 LST LST2 N J K M SS NA2 NA3 NA4 X Y Z FLAG FLAG2 FLAG3 ZLST VPNA VPLOCKED) (SETQ E1 (ENTGET NA)) (IF (OR (SETQ FLAG (EQUAL (ACET-DXF 0 E1) "POLYLINE")) (SETQ FLAG (EQUAL (ACET-DXF 0 E1) "LWPOLYLINE")) (EQUAL (ACET-DXF 0 E1) "LINE") (EQUAL (ACET-DXF 0 E1) "CIRCLE") (EQUAL (ACET-DXF 0 E1) "ARC") (EQUAL (ACET-DXF 0 E1) "ELLIPSE") (EQUAL (ACET-DXF 0 E1) "TEXT") (EQUAL (ACET-DXF 0 E1) "ATTDEF") (EQUAL (ACET-DXF 0 E1) "MTEXT") (EQUAL (ACET-DXF 0 E1) "SPLINE")) (PROGN (IF (AND FLAG (EQUAL 8 (LOGAND 8 (ACET-DXF 70 E1)))) (SETQ FLAG nil)) (SETQ A (TRANS A 1 0) VPNA (ACET-CURRENTVIEWPORT-ENAME)) (ACET-UCS-CMD (LIST "_View")) (SETQ LST (ACET-GEOM-OBJECT-POINT-LIST NA nil) LST (ACET-GEOM-LIST-EXTENTS LST) X (- (CAR (CADR LST)) (CAR (CAR LST))) Y (- (CADR (CADR LST)) (CADR (CAR LST))) X (* 0.075 X) Y (* 0.075 Y) Z (LIST X Y) X (LIST (+ (CAR (CADR LST)) (CAR Z)) (+ (CADR (CADR LST)) (CADR Z))) Y (LIST (- (CAR (CAR LST)) (CAR Z)) (- (CADR (CAR LST)) (CADR Z))) ZLST (ZOOM_2_OBJECT (LIST X Y))) (IF VPNA (SETQ VPLOCKED (ACET-VIEWPORT-LOCK-SET VPNA nil))) (COMMAND "_.zoom" "_w" (CAR ZLST) (CADR ZLST)) (ENTUPD NA) (SETQ LST (ACET-GEOM-OBJECT-POINT-LIST NA (/ (ACET-GEOM-PIXEL-UNIT) 2.0))) (IF (OR (NOT FLAG) (NOT (ACET-GEOM-SELF-INTERSECT LST nil))) (PROGN (IF (AND FLAG (EQUAL (CAR LST) (LAST LST) 0.0001)) (SETQ FLAG3 T)) (IF (SETQ LA (ACET-LAYER-LOCKED (GETVAR "clayer"))) (COMMAND "_.layer" "_unl" (GETVAR "clayer") "")) (COMMAND "_.pline") (SETQ B nil) (SETQ N 0) (REPEAT (LENGTH LST) (SETQ D (NTH N LST)) (IF (NOT (EQUAL D B 0.0001)) (PROGN (COMMAND D) (SETQ LST2 (APPEND LST2 (LIST D))) (SETQ B D))) (SETQ N (+ N 1))) (COMMAND "") (SETQ NA2 (ENTLAST) SS (SSADD) SS (SSADD NA2 SS) LST nil) (ACET-SS-VISIBLE SS 1) (SETQ LST2 (GET_FENCE_POINTS NA2 A LST2 FLAG3 FLAG)) (IF LA (COMMAND "_.layer" "_lock" (GETVAR "clayer") "")) (ACET-UCS-CMD (LIST "_p")) (SETVAR "highlight" 0) (IF (SETQ SS (SSGET "_f" (LAST LST2))) (COMMAND "_.move" SS "" "0,0,0" "0,0,0")) (IF FLAG (PROGN (IF (SETQ LA (ACET-LAYER-LOCKED (ACET-DXF 8 E1))) (COMMAND "_.layer" "_unl" (ACET-DXF 8 E1) "")) (ACET-UCS-SET-Z (ACET-DXF 210 E1)) (COMMAND "_.copy" NA "" "0,0,0" "0,0,0") (ACET-SS-VISIBLE (SSADD NA (SSADD)) 1) (SETQ NA3 NA NA (ENTLAST)) (COMMAND "_.pedit" NA "_w" "0.0" "_x") (ACET-UCS-CMD (LIST "_p")) (IF LA (COMMAND "_.layer" "_lock" (ACET-DXF 8 E1) "")))) (COMMAND "_.trim" NA "") (SETQ M (- (LENGTH LST2) 1)) (SETQ K 0) (REPEAT (LENGTH LST2) (SETQ LST (NTH K LST2)) (SETQ A (TRANS (CAR LST) 0 1)) (SETQ N 1) (REPEAT (- (LENGTH LST) 1) (SETQ B (TRANS (NTH N LST) 0 1)) (IF (EQUAL A B 0.0001) (SETQ FLAG2 T) (SETQ FLAG2 nil)) (SETQ NA4 nil) (SETQ J 0) (WHILE (NOT FLAG2) (SETQ NA4 (ENTLAST)) (COMMAND "_F" A B "") (IF (AND (EQUAL NA4 (ENTLAST)) (OR (NOT (EQUAL K M)) (> J 0))) (SETQ FLAG2 T)) (SETQ J (+ J 1))) (SETQ A B) (SETQ N (+ N 1))) (SETQ K (+ K 1))) (COMMAND "") (IF FLAG (PROGN (IF (SETQ LA (ACET-LAYER-LOCKED (ACET-DXF 8 E1))) (COMMAND "_.layer" "_unl" (ACET-DXF 8 E1) "")) (ENTDEL NA) (ACET-SS-VISIBLE (SSADD NA3 (SSADD)) 0) (IF LA (COMMAND "_.layer" "_lock" (ACET-DXF 8 E1) ""))))) (PROGN (ACET-UCS-CMD (LIST "_p")) (PRINC "\n不接受自交边界。"))) (COMMAND "_.zoom" "_p") (IF VPLOCKED (ACET-VIEWPORT-LOCK-SET VPNA T)))))
(DEFUN ANOTHER_OFFSET (PL1 PL2 A1 A2 B NA2 LST2 A LST3 LST4 / NA SS LST DA1 DA2) (SETQ DA1 (ABS (- A2 A1))) (SETQ DA2 (- (* B (MAX PL2 PL1)) (/ (* B (ABS (- PL2 PL1))) 2.0))) (IF (> (ABS (- DA2 DA1)) (* 0.01 (MAX A1 A2))) (PROGN (ACET-PLINE-MAKE (LIST LST2)) (SETQ NA (ENTLAST) NA2 (ENTLAST) SS (SSADD) SS (SSADD NA SS)) (ACET-SS-VISIBLE SS 1) (COMMAND "_.offset" B NA2 A "") (IF (AND (NOT (EQUAL NA (ENTLAST))) (SETQ LST3 (ACET-GEOM-VERTEX-LIST (ENTLAST))) (SETQ LST3 (INTERSECT_CHECK LST2 LST3 LST4))) (PROGN (ACET-SS-VISIBLE (SSADD (ENTLAST) (SSADD)) 1) (COMMAND "_.area" "_ob" (ENTLAST)) (SETQ PL2 (GETVAR "perimeter") A2 (GETVAR "area")) (SETQ LST (LIST (ACET-GEOM-VERTEX-LIST (LIST (ENTLAST) 0)))) (ENTDEL (ENTLAST))) (IF (NOT (EQUAL NA (ENTLAST))) (ENTDEL (ENTLAST)))) (ENTDEL NA2))) LST)
(DEFUN GET_FENCE_POINTS (NA2 A LST2 FLAG PLFLAG / A1 A2 PL1 PL2 B C D N LST LST2 LST3 LST4 NA) (IF FLAG (PROGN (SETQ LST2 (CDR LST2)) (REPEAT (FIX (/ (LENGTH LST2) 2)) (SETQ LST2 (APPEND (CDR LST2) (LIST (CAR LST2))))) (SETQ LST2 (APPEND LST2 (LIST (CAR LST2)))) (COMMAND "_.area" "_ob" NA2) (SETQ PL1 (GETVAR "perimeter") A1 (GETVAR "area")))) (SETQ A (TRANS A 0 1) B (* (GETVAR "viewsize") 0.05) N 3.0 D (/ B (- N 1)) C (ACET-GEOM-PIXEL-UNIT) LST4 (ACET-GEOM-VIEW-POINTS)) (WHILE (> B C) (SETQ NA (ENTLAST)) (COMMAND "_.offset" B NA2 A "") (IF (AND (NOT (EQUAL NA (ENTLAST))) (SETQ LST3 (ACET-GEOM-VERTEX-LIST (ENTLAST))) (OR (NOT PLFLAG) (SETQ LST3 (INTERSECT_CHECK LST2 LST3 LST4)))) (PROGN (SETQ LST3 (ACET-GEOM-M-TRANS LST3 1 0)) (ACET-SS-VISIBLE (SSADD (ENTLAST) (SSADD)) 1) (IF FLAG (PROGN (COMMAND "_.area" "_ob" (ENTLAST)) (SETQ PL2 (GETVAR "perimeter") A2 (GETVAR "area")))) (SETQ LST (APPEND LST (LIST LST3))) (ENTDEL (ENTLAST)) (IF FLAG (SETQ LST (APPEND LST (ANOTHER_OFFSET PL1 PL2 A1 A2 B NA2 LST2 A LST3 LST4))))) (IF (NOT (EQUAL NA (ENTLAST))) (ENTDEL (ENTLAST)))) (SETQ B (- B D))) (SETQ NA (ENTLAST)) (COMMAND "_.offset" C NA2 A "") (IF (AND (NOT (EQUAL NA (ENTLAST))) (SETQ LST3 (ACET-GEOM-VERTEX-LIST (ENTLAST))) (OR (NOT PLFLAG) (SETQ LST3 (INTERSECT_CHECK LST2 LST3 LST4)))) (PROGN (SETQ LST3 (ACET-GEOM-M-TRANS LST3 1 0)) (ACET-SS-VISIBLE (SSADD (ENTLAST) (SSADD)) 1) (IF FLAG (PROGN (COMMAND "_.area" "_ob" (ENTLAST)) (SETQ PL2 (GETVAR "perimeter") A2 (GETVAR "area")))) (SETQ LST (APPEND LST (LIST LST3))) (ENTDEL (ENTLAST)) (IF FLAG (SETQ LST (APPEND LST (ANOTHER_OFFSET PL1 PL2 A1 A2 C NA2 LST2 A LST3 LST4))))) (IF (NOT (EQUAL NA (ENTLAST))) (ENTDEL (ENTLAST)))) (ENTDEL NA2) LST)
(DEFUN INTERSECT_CHECK (LST LST2 LST3 / X X2 Y Y2 LST4 FLAG LEN LEN2 A AA B BB C D N J) (SETQ LEN (LENGTH LST) LEN2 (LENGTH LST2) X (CAR (CAR LST3)) X2 (CAR (CADR LST3)) Y (CADR (CAR LST3)) Y2 (CADR (CADR LST3))) (SETQ N 0) (WHILE (AND (NOT FLAG) (< (+ N 1) LEN2)) (SETQ AA (NTH N LST2) BB (NTH (+ N 1) LST2) A (BNS_TRUNCATE_2_VIEW AA BB X Y X2 Y2) B (BNS_TRUNCATE_2_VIEW BB AA X Y X2 Y2) LST4 (APPEND LST4 (LIST A))) (IF (OR (NOT (EQUAL A AA)) (NOT (EQUAL B BB))) (SETQ LST4 (APPEND LST4 (LIST B)))) (SETQ J 0) (WHILE (AND (NOT FLAG) (< (+ J 1) LEN)) (SETQ C (NTH J LST) D (NTH (+ J 1) LST) FLAG (INTERS A B C D)) (SETQ J (+ J 1))) (SETQ N (+ N 1))) (IF (NOT (EQUAL B (LAST LST4))) (SETQ LST4 (APPEND LST4 (LIST B)))) (IF (NOT FLAG) (SETQ FLAG LST4) (SETQ FLAG nil)) FLAG)
(DEFUN ZOOM_2_OBJECT (LST / P1 P2 P3 P4 P5 P6 MP DX DY DX2 DY2 R1 R2 NA E1 X W H DV1 DV2 X) (SETQ LST (ACET-GEOM-M-TRANS LST 1 2) P1 (ACET-GEOM-M-TRANS (ACET-GEOM-VIEW-POINTS) 1 2) P2 (CADR P1) P1 (CAR P1) P1 (LIST (CAR P1) (CADR P1)) P2 (LIST (CAR P2) (CADR P2))) (IF LST (PROGN (SETQ P5 (ACET-GEOM-LIST-EXTENTS LST) P6 (CADR P5) P5 (CAR P5) P5 (LIST (CAR P5) (CADR P5)) P6 (LIST (CAR P6) (CADR P6)) MP (ACET-GEOM-MIDPOINT P5 P6) DX (- (CAR P2) (CAR P1)) DY (- (CADR P2) (CADR P1)) DX2 (- (CAR P6) (CAR P5)) DY2 (- (CADR P6) (CADR P5))) (IF (EQUAL DX 0.0) (SETQ DX 1.0e-006)) (IF (EQUAL DX2 0.0) (SETQ DX2 1.0e-006)) (SETQ R1 (/ DY DX) R2 (/ DY2 DX2)) (IF (< R2 R1) (SETQ DY2 (* R1 DX2)) (PROGN (IF (EQUAL R1 0.0) (SETQ R1 1.0e-006)) (SETQ DX2 (* DY2 (/ 1.0 R1))))) (SETQ P5 (LIST (- (CAR MP) (/ DX2 1.98)) (- (CADR MP) (/ DY2 1.98))) P6 (LIST (+ (CAR MP) (/ DX2 1.98)) (+ (CADR MP) (/ DY2 1.98)))))) (IF (AND LST (EQUAL 0 (GETVAR "tilemode")) (NOT (EQUAL 1 (GETVAR "cvport"))) (SETQ NA (ACET-CURRENTVIEWPORT-ENAME))) (PROGN (SETQ E1 (ENTGET NA) X (CDR (ASSOC 10 E1)) W (CDR (ASSOC 40 E1)) H (CDR (ASSOC 41 E1)) P3 (LIST (- (CAR X) (/ W 2.0)) (- (CADR X) (/ H 2.0))) P4 (LIST (+ (CAR X) (/ W 2.0)) (+ (CADR X) (/ H 2.0))) P3 (TRANS P3 3 2) P4 (TRANS P4 3 2) DV1 (ACET-GEOM-DELTA-VECTOR P1 P3) DV2 (ACET-GEOM-DELTA-VECTOR P2 P4) X (DISTANCE P1 P2)) (IF (EQUAL 0 X) (SETQ X 1.0e-006)) (SETQ X (/ (DISTANCE P5 P6) X) DV1 (ACET-GEOM-VECTOR-SCALE DV1 X) DV2 (ACET-GEOM-VECTOR-SCALE DV2 X) P5 (ACET-GEOM-VECTOR-ADD P5 DV1) P6 (ACET-GEOM-VECTOR-ADD P6 DV2)))) (SETQ P1 (LIST (CAR P1) (CADR P1) 0.0) P2 (LIST (CAR P2) (CADR P2) 0.0) P5 (LIST (CAR P5) (CADR P5) 0.0) P6 (LIST (CAR P6) (CADR P6) 0.0)) (IF LST (SETQ LST (LIST (TRANS P5 2 1) (TRANS P6 2 1))) (SETQ LST nil)) LST)
(PRINC)
