(DEFUN C:CLIPIT (/ NA NA2 E1 E2 A LST ZFLAG REDRAW_IT GLST VPLOCKED VPNA) (ACET-ERROR-INIT (LIST (LIST "cmdecho" 0 "highlight" 0 "regenmode" 1 "osmode" 0 "orthomode" 0 "ucsfollow" 0 "limcheck" 0 "plinewid" 0) T (QUOTE (WHILE REDRAW_IT (REDRAW (CAR REDRAW_IT) 4) (SETQ REDRAW_IT (CDR REDRAW_IT)))))) (SETQ GLST (BNS_GROUPS_UNSEL)) (PRINC "\n为剪裁边界拾取多段线、圆、椭圆或文字对象...") (SETQ NA (ACET-UI-SINGLE-SELECT (QUOTE ((-4 . "<OR") (0 . "*POLYLINE") (0 . "ARC") (0 . "CIRCLE") (0 . "ATTDEF") (0 . "TEXT") (0 . "MTEXT") (0 . "ELLIPSE") (0 . "SPLINE") (0 . "3DFACE") (0 . "SOLID") (0 . "TRACE") (-4 . "OR>"))) T)) (IF NA (PROGN (SETQ E1 (ENTGET NA)) (SETQ REDRAW_IT (LIST NA)) (REDRAW NA 3) (PRINC "\n拾取图像、隐藏区域或外部参照/块供剪裁...") (SETQ NA2 (ACET-UI-SINGLE-SELECT (QUOTE ((-4 . "<OR") (0 . "IMAGE") (0 . "INSERT") (0 . "WIPEOUT") (-4 . "OR>"))) nil)) (SETQ REDRAW_IT nil) (REDRAW NA 4) (IF NA2 (PROGN (SETQ E2 (ENTGET NA2)) (SETVAR "cmdecho" 0) (SETVAR "highlight" 1) (COMMAND "_.select" NA NA2) (SETQ A (GET_CLIPITRES)) (COMMAND "") (ENTUPD NA) (SETQ LST (ACET-GEOM-OBJECT-POINT-LIST NA A)) (IF (OR (NOT (EQUAL "INSERT" (ACET-DXF 0 E2))) (NOT (ACET-GEOM-SELF-INTERSECT LST nil))) (PROGN (IF (EQUAL (CAR LST) (LAST LST) 0.001) (SETQ LST (CDR LST))) (IF (OR (EQUAL "INSERT" (ACET-DXF 0 E2)) (EQUAL "IMAGE" (ACET-DXF 0 E2))) (PROGN (IF (SETQ VPNA (ACET-CURRENTVIEWPORT-ENAME)) (SETQ VPLOCKED (ACET-VIEWPORT-LOCK-SET VPNA nil))) (IF (SETQ ZFLAG (ACET-GEOM-ZOOM-FOR-SELECT LST)) (COMMAND "_.zoom" "_w" (CAR ZFLAG) (CADR ZFLAG))) (C_CLIPIT NA2 LST) (IF ZFLAG (COMMAND "_.zoom" "_p")) (IF VPLOCKED (ACET-VIEWPORT-LOCK-SET VPNA T))) (WIPEOUT_CLIPIT NA2 LST))) (PRINC "\n无效。供外部参照剪裁的约束图元不能自交。")))))) (BNS_GROUPS_SEL GLST) (ACET-ERROR-RESTORE) (PRINC))
(DEFUN GET_CLIPITRES (/ A N) (IF (NOT #CLIPITRES) (PROGN (SETQ #CLIPITRES 0.0) (SETQ N 0) (WHILE (EQUAL #CLIPITRES 0.0) (SETQ #CLIPITRES (ACET-GEOM-PIXEL-UNIT) #CLIPITRES (RTOS #CLIPITRES 2 (+ (FIX (/ (GETVAR "luprec") 2.0)) N)) #CLIPITRES (ATOF #CLIPITRES)) (SETQ N (+ N 1))))) (INITGET 2) (SETQ A (GETDIST (ACET-STR-FORMAT "\n输入融入圆弧段的最大允许误差距离 <%1>: " (RTOS #CLIPITRES)))) (IF (NOT A) (SETQ A #CLIPITRES) (SETQ #CLIPITRES A)) #CLIPITRES)
(DEFUN C_CLIPIT (NA LST / E1 N LST2 LST3 RES) (SETQ LST (PLIST_OPTIMIZE LST)) (IF (EQUAL (QUOTE PICKSET) (TYPE NA)) (SETQ E1 (ENTGET (SSNAME NA 0))) (SETQ E1 (ENTGET NA))) (IF (EQUAL "IMAGE" (CDR (ASSOC 0 E1))) (PROGN (SETQ LST2 (ACET-GEOM-IMAGE-BOUNDS NA) LST3 (PRE_PROCCESS_BOUNDARY LST LST2)) (SETQ N 0) (REPEAT (LENGTH LST3) (SETQ LST (NTH N LST3)) (SETQ RES (C_CLIPIT_SUB NA LST)) (COMMAND "_.copy" NA "" "0,0,0" "0,0,0") (SETQ NA (ENTLAST)) (SETQ N (+ N 1))) (ENTDEL NA)) (SETQ RES (C_CLIPIT_SUB NA LST))) RES)
(DEFUN C_CLIPIT_SUB (NA LST / E1 LST2 A N) (IF (EQUAL (QUOTE PICKSET) (TYPE NA)) (SETQ E1 (ENTGET (SSNAME NA 0))) (SETQ E1 (ENTGET NA))) (IF (EQUAL "INSERT" (CDR (ASSOC 0 E1))) (PROGN (COMMAND "_.xclip" NA "" "_n") (IF (AND (SETQ E1 (MEMBER (QUOTE (102 . "{ACAD_XDICTIONARY")) E1)) (SETQ E1 (CDR E1)) (SETQ NA (CDR (ASSOC 360 E1))) (SETQ E1 (ENTGET NA)) (ASSOC 360 (MEMBER (QUOTE (3 . "ACAD_FILTER")) E1))) (COMMAND "_y"))) (PROGN (SETQ LST2 (ACET-GEOM-IMAGE-BOUNDS NA)) (SETQ LST2 nil) (COMMAND "_.imageclip" NA "_n") (IF (EQUAL 1 (CDR (ASSOC 280 E1))) (COMMAND "_y")))) (COMMAND "_p") (SETQ N 0) (REPEAT (LENGTH LST) (SETQ A (NTH N LST)) (IF (AND (OR (NOT LST2) (NOT (EQUAL (NTH N LST) (LAST LST2) 1.0e-006)))) (PROGN (COMMAND A) (SETQ LST2 (APPEND LST2 (LIST A))))) (SETQ N (+ N 1))) (IF (< (LENGTH LST2) 3) (COMMAND nil) (COMMAND "")) (>= (LENGTH LST2) 3))
(DEFUN PRE_PROCCESS_BOUNDARY (LST LST2 / SP_INTERS A LST3 DST P1 P2 P3 P4 N B SIDE D C LST4 CNT LST5 LST6 J DX DY) (DEFUN SP_INTERS (A B C D / X) (IF (SETQ X (INTERS A B C D)) (SETQ X (LIST X))) X) (IF (NOT (EQUAL (CAR LST) (LAST LST) 0.0001)) (SETQ LST (APPEND LST (LIST (CAR LST))))) (SETQ A (CAR LST) LST3 (LIST A) DST (LIST A) P1 (NTH 0 LST2) P2 (NTH 1 LST2) P3 (NTH 2 LST2) P4 (NTH 3 LST2)) (SETQ N 1) (REPEAT (MAX 0 (- (LENGTH LST) 1)) (SETQ B (NTH N LST) DST (ACET-CLIPIT-LIST-EXTENTS (APPEND DST (LIST B))) SIDE 0) (SETQ D nil) (IF (SETQ C (SP_INTERS A B P1 P2)) (SETQ D (APPEND D C) SIDE (+ SIDE 1))) (IF (SETQ C (SP_INTERS A B P2 P3)) (SETQ D (APPEND D C) SIDE (+ SIDE 2))) (IF (SETQ C (SP_INTERS A B P3 P4)) (SETQ D (APPEND D C) SIDE (+ SIDE 4))) (IF (SETQ C (SP_INTERS A B P4 P1)) (SETQ D (APPEND D C) SIDE (+ SIDE 8))) (IF D (PROGN (IF (> (LENGTH D) 1) (PROGN (IF (> (LENGTH D) 2) (PROGN (SETQ D (LIST (CAR D) (CADDR D))))) (IF (< (DISTANCE (CAR D) A) (DISTANCE (CADR D) A)) (SETQ LST3 (APPEND LST3 D)) (SETQ LST3 (APPEND LST3 (REVERSE D)))) (IF (AND (OR (NOT (IN_BOUNDS A LST2)) (EQUAL A (CAR D) 0.0001) (EQUAL A (CADR D) 0.0001)) (NOT (EQUAL 0 (CADR (LAST LST4))))) (SETQ LST4 (APPEND LST4 (LIST (LIST (- (LENGTH LST3) 2) 0 SIDE))))) (IF (AND (NOT (IN_BOUNDS B LST2)) (NOT (EQUAL 1 (CADR (LAST LST4))))) (SETQ LST4 (APPEND LST4 (LIST (LIST (- (LENGTH LST3) 1) 1 SIDE)))))) (PROGN (SETQ D (CAR D)) (SETQ LST3 (APPEND LST3 (LIST D))) (IF (AND (IN_BOUNDS B LST2) (OR (NOT (IN_BOUNDS A LST2)) (EQUAL A D 0.0001)) (NOT (EQUAL 0 (CADR (LAST LST4))))) (PROGN (SETQ LST4 (APPEND LST4 (LIST (LIST (- (LENGTH LST3) 1) 0 SIDE))))) (PROGN (IF (AND (IN_BOUNDS A LST2) (NOT (IN_BOUNDS B LST2)) (NOT (EQUAL 1 (CADR (LAST LST4))))) (PROGN (SETQ LST4 (APPEND LST4 (LIST (LIST (- (LENGTH LST3) 1) 1 SIDE)))))))))))) (IF (NOT (EQUAL B (LAST LST3) 0.0001)) (SETQ LST3 (APPEND LST3 (LIST B)))) (SETQ A B) (SETQ N (+ N 1))) (SETQ DST (* 2.0 (DISTANCE (CAR DST) (CADR DST)))) (IF LST4 (PROGN (IF (NOT (EQUAL 1 (CADR (CAR LST4)))) (SETQ LST4 (APPEND (CDR LST4) (LIST (CAR LST4))))) (IF (NOT (EQUAL (LENGTH LST4) (* 2 (/ (LENGTH LST4) 2)))) (PROGN (SETQ LST4 (REVERSE (CDR (REVERSE LST4)))))) (SETQ N 0) (REPEAT (/ (LENGTH LST4) 2) (SETQ B (NTH N LST4) C (NTH (+ N 1) LST4) CNT (LENGTH LST5)) (SETQ LST5 (APPEND LST5 (ADD_CORNERS (CAR B) (CAR C) LST3 LST2))) (WHILE (< (+ CNT 1) (LENGTH LST5)) (SETQ LST6 (APPEND LST6 (LIST CNT))) (SETQ CNT (+ CNT 1))) (SETQ J (CAR C)) (IF (EQUAL (+ N 2) (LENGTH LST4)) (SETQ C (CAR LST4)) (SETQ C (NTH (+ N 2) LST4))) (WHILE (/= J (CAR C)) (IF (NOT (EQUAL (LAST LST5) (NTH J LST3) 0.0001)) (SETQ LST5 (APPEND LST5 (LIST (NTH J LST3))))) (SETQ J (+ J 1)) (IF (EQUAL J (LENGTH LST3)) (SETQ J 0))) (SETQ N (+ N 2))))) (IF LST5 (PROGN (SETQ DX 0.0 DY 0.0) (SETQ N 0) (WHILE (AND (< (+ N 1) (LENGTH LST5)) (OR (EQUAL DX 0.0 1.0e-005) (EQUAL DY 0.0 1.0e-005))) (SETQ DX (+ (ABS (- (CAR (NTH (+ N 1) LST5)) (CAR (NTH N LST5)))) DX) DY (+ (ABS (- (CADR (NTH (+ N 1) LST5)) (CADR (NTH N LST5)))) DY)) (SETQ N (+ N 1))) (IF (OR (EQUAL DX 0.0 1.0e-005) (EQUAL DY 0.0 1.0e-005)) (SETQ LST3 nil LST5 nil) (PROGN (SETQ LST3 LST5 LST5 nil) (IF (AND LST3 LST6) (PROGN (SETQ LST3 (SPLIT_AT_PINCH2 LST3 LST6))) (PROGN (IF LST3 (SETQ LST3 (LIST LST3)))))))) (PROGN (IF (NOT (IN_BOUNDS (CAR LST3) LST2)) (PROGN (IF (OR (ACET-GEOM-POINT-INSIDE (NTH 0 LST2) LST3 DST) (ACET-GEOM-POINT-INSIDE (NTH 1 LST2) LST3 DST) (ACET-GEOM-POINT-INSIDE (NTH 2 LST2) LST3 DST) (ACET-GEOM-POINT-INSIDE (NTH 3 LST2) LST3 DST)) (SETQ LST3 LST2) (SETQ LST3 nil)))) (IF LST3 (SETQ LST3 (LIST LST3))))) LST3)
(DEFUN SPLIT_AT_PINCH2 (LST LST2 / N K A B X1 FLAG J M C D X2 X3 LST3 LST4 LST5) (SETQ N 0) (REPEAT (MAX (- (LENGTH LST2) 1) 0) (SETQ K (NTH N LST2) A (NTH K LST) B (NTH (+ K 1) LST) X1 (ACET-CLIPIT-LIST-EXTENTS (LIST A B))) (SETQ FLAG nil) (SETQ J (+ N 1)) (WHILE (AND (NOT FLAG) (< J (LENGTH LST2))) (SETQ M (NTH J LST2) C (NTH M LST) D (NTH (+ M 1) LST) X2 (ACET-CLIPIT-LIST-EXTENTS (LIST C D)) X3 (ACET-CLIPIT-LIST-EXTENTS (APPEND X1 X2))) (IF (AND (OR (AND (EQUAL (CAR X3) (CAR X1) 0.0001) (EQUAL (CADR X3) (CADR X1) 0.0001)) (AND (EQUAL (CAR X3) (CAR X2) 0.0001) (EQUAL (CADR X3) (CADR X2) 0.0001))) (EQUAL 0.0 (ACET-GEOM-VECTOR-SIDE C A B)) (EQUAL 0.0 (ACET-GEOM-VECTOR-SIDE D A B))) (SETQ LST3 (APPEND LST3 (LIST (LIST K M))))) (SETQ J (+ J 1))) (SETQ N (+ N 1))) (SETQ N 0) (REPEAT (MAX 0 (- (LENGTH LST3) 1)) (SETQ A (NTH N LST3) B (CADR A) A (CAR A) C (NTH (+ N 1) LST3) D (CADR C) C (CAR C)) (SETQ LST4 (APPEND LST4 (LIST (LIST (+ A 1) (IF (NOT (EQUAL (MIN B C) A)) (MIN B C) B))))) (SETQ N (+ N 1))) (IF LST3 (PROGN (SETQ A (NTH N LST3) B (CADR A) A (CAR A) C (CAR LST3) D (CADR C) C (CAR C)) (SETQ LST4 (APPEND LST4 (LIST (LIST (MAX (+ A 1) (IF LST4 (+ (CADR (LAST LST4)) 1) 0)) B)) (LIST (LIST (+ B 1) C)))))) (IF (AND LST3 LST4) (PROGN (SETQ N 0) (REPEAT (LENGTH LST4) (SETQ A (NTH N LST4) J (CAR A)) (SETQ LST3 nil) (WHILE (NOT (EQUAL J (CADR A))) (SETQ LST3 (APPEND LST3 (LIST (NTH J LST)))) (SETQ J (+ J 1)) (IF (= J (LENGTH LST)) (SETQ J 0))) (SETQ LST3 (APPEND LST3 (LIST (NTH J LST)))) (IF (> (LENGTH LST3) 2) (PROGN (IF (> (LENGTH LST3) 3) (PROGN (IF (NOT (EQUAL (CAR LST3) (LAST LST3))) (SETQ LST3 (APPEND LST3 (LIST (CAR LST3))))) (SETQ LST3 (SPLIT_AT_PINCH2 LST3 (LIST 0 (- (LENGTH LST3) 2))))) (SETQ LST3 (LIST LST3))) (SETQ LST5 (APPEND LST5 LST3)))) (SETQ N (+ N 1))) (IF LST5 (SETQ LST LST5) (SETQ LST (LIST LST)))) (SETQ LST (LIST LST))) LST)
(DEFUN ADD_CORNERS (NN JJ LST3 LST2 / MXMN LEN N A B LST LST4) (SETQ MXMN (LIST (NTH NN LST3)) LEN (LENGTH LST3)) (SETQ N NN) (WHILE (NOT (EQUAL N JJ)) (SETQ A (NTH N LST3) MXMN (ACET-CLIPIT-LIST-EXTENTS (APPEND (LIST A) MXMN))) (IF (NOT (EQUAL A (LAST LST) 0.0001)) (SETQ LST (APPEND LST (LIST A)))) (SETQ N (+ N 1)) (IF (= N LEN) (SETQ N 0))) (SETQ A (NTH N LST3) MXMN (ACET-CLIPIT-LIST-EXTENTS (APPEND (LIST A) MXMN)) LST (APPEND LST (LIST A))) (SETQ MXMN (* 4.0 (DISTANCE (CAR MXMN) (CADR MXMN))) B MXMN) (IF (NOT (EQUAL (CAR LST) (LAST LST) 0.0001)) (SETQ LST (APPEND LST (LIST (CAR LST))))) (SETQ LST2 (CDR LST2)) (SETQ N 0) (REPEAT (LENGTH LST2) (SETQ A (NTH N LST2)) (IF (NOT (ACET-GEOM-POINT-INSIDE A LST MXMN)) (SETQ A nil)) (SETQ LST4 (APPEND LST4 (LIST A))) (SETQ N (+ N 1))) (SETQ B (LIST B (CAR LST4))) (IF (MEMBER nil LST4) (PROGN (WHILE (CAR LST4) (SETQ LST4 (APPEND (CDR LST4) (LIST (CAR LST4))))) (WHILE (AND LST4 (NOT (CAR LST4))) (SETQ LST4 (CDR LST4))) (IF (NOT (LAST LST4)) (PROGN (SETQ LST4 (REVERSE LST4)) (WHILE (AND LST4 (NOT (CAR LST4))) (SETQ LST4 (CDR LST4))) (SETQ LST4 (REVERSE LST4))))) (PROGN (IF (EQUAL (LENGTH LST4) 4) (PROGN (WHILE (NOT (EQUAL 0 (ACET-GEOM-VECTOR-SIDE (NTH NN LST3) (CAR LST4) (LAST LST4)))) (SETQ LST4 (APPEND (CDR LST4) (LIST (CAR LST4))))))))) (IF LST4 (PROGN (IF (< (DISTANCE (NTH NN LST3) (LAST LST4)) (DISTANCE (NTH NN LST3) (CAR LST4))) (SETQ LST4 (REVERSE LST4))) (IF (AND (< (DISTANCE (NTH JJ LST3) (CAR LST4)) (DISTANCE (NTH NN LST3) (CAR LST4))) (< (DISTANCE (NTH JJ LST3) (CAR LST4)) (DISTANCE (NTH JJ LST3) (LAST LST4)))) (SETQ LST4 (REVERSE LST4))))) (IF (NOT (EQUAL (NTH NN LST3) (CAR LST4) 0.0001)) (SETQ LST4 (APPEND (LIST (NTH NN LST3)) LST4))) (IF (NOT (EQUAL (NTH JJ LST3) (LAST LST4) 0.0001)) (SETQ LST4 (APPEND LST4 (LIST (NTH JJ LST3))))) LST4)
(DEFUN IN_BOUNDS (P1 LST / A B C) (SETQ B (CAR LST) B (LIST (CAR B) (CADR B)) C (CADDR LST) C (LIST (CAR C) (CADR C)) A (ANGLE B (CADR LST))) (IF (< A 0) (SETQ A (+ A (* 2.0 PI)))) (SETQ A (* -1.0 A) C (ACET-GEOM-POINT-ROTATE C B A) P1 (ACET-GEOM-POINT-ROTATE P1 B A) LST (ACET-CLIPIT-LIST-EXTENTS (LIST B C P1))) (AND (EQUAL (CAR LST) B 1.0e-006) (EQUAL (CADR LST) C 1.0e-006)))
(DEFUN WIPEOUT_CLIPIT (NA LST / NA2 LA N A) (IF NA (ENTDEL NA)) (IF (SETQ LA (ACET-LAYER-LOCKED (GETVAR "clayer"))) (COMMAND "_.layer" "_un" (GETVAR "clayer") "")) (COMMAND "_.pline") (SETQ N 0) (REPEAT (LENGTH LST) (SETQ A (NTH N LST)) (COMMAND A) (SETQ N (+ N 1))) (COMMAND "") (SETQ NA2 (ENTLAST)) (COMMAND "_.pedit" NA2 "_cl" "_x") (COMMAND "_.wipeout" "_n" NA2 "_y") (IF LA (COMMAND "_.layer" "_lock" (GETVAR "clayer") "")))
(DEFUN PLIST_OPTIMIZE (LST / N A B C D LST2) (IF (NOT (EQUAL (CAR LST) (LAST LST) 1.0e-005)) (SETQ LST (APPEND LST (LIST (CAR LST))))) (SETQ N 0) (REPEAT (MAX 0 (- (LENGTH LST) 1)) (SETQ A (NTH N LST) B (NTH (+ N 1) LST)) (IF (EQUAL N 0) (SETQ LST2 (LIST A B))) (SETQ C (NTH (MAX (- (LENGTH LST2) 2) 0) LST2) D (LAST LST2)) (IF (EQUAL (ANGLE A B) (ANGLE C D) 1.0e-006) (SETQ LST2 (REVERSE (CDR (REVERSE LST2))))) (IF (NOT (EQUAL B (LAST LST2))) (SETQ LST2 (APPEND LST2 (LIST B)))) (SETQ N (+ N 1))) (IF (AND (>= (LENGTH LST2) 4) (EQUAL (ANGLE (CAR LST2) (CADR LST2)) (ANGLE (NTH (- (LENGTH LST2) 2) LST2) (LAST LST2)) 1.0e-006)) (SETQ LST2 (CDR LST2) LST2 (REVERSE (CDR (REVERSE LST2))))) LST2)
(DEFUN ACET-CLIPIT-LIST-EXTENTS (LST / A B) (SETQ LST (ACET-GEOM-LIST-EXTENTS LST) A (CAR LST) B (CADR LST)) (LIST (LIST (CAR A) (CADR A)) (LIST (CAR B) (CADR B))))
(PRINC)
