(DEFUN ACET-OVERKILL2 (ALST / LST SS FUZ IGNORE NO-PLINES NO-PARTIAL NO-ENDTOEND SS2 N NA PLST NA2 VLST J K) (SETQ LST (QUOTE (SS FUZ IGNORE NO-PLINES NO-PARTIAL NO-ENDTOEND))) (SETQ N 0) (REPEAT (MIN (LENGTH ALST) (LENGTH LST)) (SET (NTH N LST) (NTH N ALST)) (SETQ N (+ N 1))) (SETQ LST nil) (ACET-SYSVAR-SET (QUOTE ("highlight" 0 "ucsicon" 0 "pickstyle" 0 "osmode" 0))) (IF (NOT NO-PLINES) (PROGN (SETQ PLST (ACET-PLINES-EXPLODE SS) SS (CAR PLST) PLST (CADR PLST)))) (SETQ SS2 (ACET-SS-REMOVE-DUPS SS FUZ IGNORE) SS (CAR SS2) SS2 (CADR SS2)) (IF SS2 (PROGN (PRINC (ACET-STR-FORMAT "\n删除%1个重复。\n" (ITOA (SSLENGTH SS2))))) (SETQ SS2 (SSADD))) (IF (NOT (AND NO-PARTIAL NO-ENDTOEND)) (PROGN (SETQ VLST (ACET-OVERKILL-SS->PRIMITIVES2 SS 1.0e-007 IGNORE) J 0))) (ACET-UI-PROGRESS-INIT "Optimizing objects" (LENGTH VLST)) (SETQ N 1) (FOREACH LST VLST (IF (> (LENGTH LST) 2) (PROGN (IF (= 0 (CAR (CAR LST))) (SETQ K (ACET-OVERKILL-RESOLVE-LINES2 LST SS2 FUZ NO-PARTIAL NO-ENDTOEND)) (SETQ K (ACET-OVERKILL-RESOLVE-ARCS2 LST SS2 FUZ NO-PARTIAL NO-ENDTOEND))) (SETQ SS2 (CADR K) K (CAR K) J (+ J K)) (PRINC "                                                      ") (PRINC "\r") (PRINC (ACET-STR-FORMAT "删除%1个对象。" (ITOA J))))) (ACET-UI-PROGRESS-SAFE N) (SETQ N (+ N 1))) (ACET-UI-PROGRESS-DONE) (SETQ NA (ENTLAST)) (IF (AND SS2 (> (SSLENGTH SS2) 0)) (ACET-SS-ENTDEL SS2)) (IF PLST (ACET-PLINES-REBUILD PLST)) (IF (AND SS2 (> (SSLENGTH SS2) 0)) (PROGN (ACET-SS-ENTDEL SS2) (ACET-SAFE-COMMAND T T (LIST "_.erase" SS2 ""))) (ACET-SS-CLEAR-PREV)) (ACET-SYSVAR-RESTORE) (PRINC "\n") SS2)
(DEFUN ACET-OVERKILL-RESOLVE-LINES2 (LST SS2 FUZ NO-PARTIAL NO-ENDTOEND / INDEX M M2 N X NA NA2 P1 P2 P3 P4 MOD J A B E1) (SETQ A (CAR LST) LST (CDR LST) M (NTH 1 A) M2 (NTH 3 A)) (COND (M (SETQ INDEX 0)) (M2 (SETQ INDEX 1)) (T (SETQ INDEX 2))) (SETQ LST (MAPCAR (QUOTE (LAMBDA (X / A B) (IF (< (NTH INDEX (CAR X)) (NTH INDEX (CADR X))) (SETQ A (CAR X) B (CADR X)) (SETQ B (CAR X) A (CADR X))) (LIST A B (CADDR X)))) LST) LST (VL-SORT LST (QUOTE (LAMBDA (A B) (< (NTH INDEX (CAR A)) (NTH INDEX (CAR B)))))) X (CAR LST) P1 (CAR X) P2 (CADR X) NA (CADDR X) J 0) (SETQ N 1) (REPEAT (- (LENGTH LST) 1) (SETQ X (NTH N LST) P3 (CAR X) P4 (CADR X) NA2 (CADDR X)) (COND ((EQUAL (NTH INDEX P3) (NTH INDEX P2) FUZ) (IF (NOT NO-ENDTOEND) (PROGN (IF (> (NTH INDEX P4) (NTH INDEX P2)) (SETQ P2 P4 MOD T)) (SETQ SS2 (SSADD NA2 SS2)) (SETQ J (+ J 1))))) ((< (NTH INDEX P3) (NTH INDEX P2)) (IF (NOT NO-PARTIAL) (PROGN (IF (> (NTH INDEX P4) (NTH INDEX P2)) (SETQ P2 P4 MOD T)) (SETQ SS2 (SSADD NA2 SS2)) (SETQ J (+ J 1))))) (T (IF MOD (PROGN (SETQ E1 (ENTGET NA) E1 (SUBST (CONS 10 P1) (ASSOC 10 E1) E1) E1 (SUBST (CONS 11 P2) (ASSOC 11 E1) E1)) (ENTMOD E1))) (SETQ P1 P3 P2 P4 NA NA2) (SETQ MOD nil))) (SETQ N (+ N 1))) (IF MOD (PROGN (SETQ E1 (ENTGET NA) E1 (SUBST (CONS 10 P1) (ASSOC 10 E1) E1) E1 (SUBST (CONS 11 P2) (ASSOC 11 E1) E1)) (ENTMOD E1))) (LIST J SS2))
(DEFUN ACET-OVERKILL-RESOLVE-ARCS2 (LST SS2 FUZ NO-PARTIAL NO-ENDTOEND / INDEX SLOPE N X NA NA2 A B A2 B2 MOD J E1) (SETQ LST (CDR LST) LST (MAPCAR (QUOTE (LAMBDA (X / A B) (SETQ A (ACET-ANGLE-FORMAT (NTH 2 X)) B (ACET-ANGLE-FORMAT (NTH 3 X))) (IF (<= B A) (SETQ B (+ B PI PI))) (LIST (NTH 0 X) (NTH 1 X) A B (NTH 4 X)))) LST) LST (VL-SORT LST (QUOTE (LAMBDA (A B) (< (NTH 2 A) (NTH 2 B))))) X (CAR LST) A (NTH 2 X) B (NTH 3 X) NA (NTH 4 X) J 0) (SETQ N 1) (REPEAT (- (LENGTH LST) 1) (SETQ X (NTH N LST) A2 (NTH 2 X) B2 (NTH 3 X) NA2 (NTH 4 X)) (COND ((EQUAL A2 B 1.0e-008) (IF (NOT NO-ENDTOEND) (PROGN (IF (> B2 B) (SETQ B B2 MOD T)) (SETQ SS2 (SSADD NA2 SS2)) (SETQ J (+ J 1))))) ((< A2 B) (IF (NOT NO-PARTIAL) (PROGN (IF (> B2 B) (SETQ B B2 MOD T)) (SETQ SS2 (SSADD NA2 SS2)) (SETQ J (+ J 1))))) (T (IF MOD (PROGN (SETQ E1 (ENTGET NA)) (IF (ACET-ANGLE-EQUAL A B 1.0e-008) (PROGN (SETQ E1 (SUBST (QUOTE (0 . "CIRCLE")) (ASSOC 0 E1) E1) E1 (VL-REMOVE (ASSOC 50 E1) E1) E1 (VL-REMOVE (ASSOC 51 E1) E1)) (WHILE (ASSOC 100 E1) (SETQ E1 (VL-REMOVE (ASSOC 100 E1) E1))) (ENTMAKE E1) (ENTDEL NA) (SETQ NA (ENTLAST))) (PROGN (SETQ E1 (SUBST (CONS 50 A) (ASSOC 50 E1) E1) E1 (SUBST (CONS 51 B) (ASSOC 51 E1) E1)) (ENTMOD E1))))) (SETQ A A2 B B2 NA NA2) (SETQ MOD nil))) (SETQ N (+ N 1))) (IF MOD (PROGN (SETQ E1 (ENTGET NA)) (IF (ACET-ANGLE-EQUAL A B 1.0e-008) (PROGN (SETQ E1 (SUBST (QUOTE (0 . "CIRCLE")) (ASSOC 0 E1) E1) E1 (VL-REMOVE (ASSOC 50 E1) E1) E1 (VL-REMOVE (ASSOC 51 E1) E1)) (WHILE (ASSOC 100 E1) (SETQ E1 (VL-REMOVE (ASSOC 100 E1) E1))) (ENTMAKE E1) (ENTDEL NA) (SETQ NA (ENTLAST))) (PROGN (SETQ E1 (SUBST (CONS 50 A) (ASSOC 50 E1) E1) E1 (SUBST (CONS 51 B) (ASSOC 51 E1) E1)) (ENTMOD E1))))) (LIST J SS2))
(DEFUN ACET-OVERKILL-LINE-DATA2 (E1 FUZ GENPROPS / P1 P2 DX DY DZ M B M2 B2 XV TH) (SETQ P1 (CDR (ASSOC 10 E1)) P2 (CDR (ASSOC 11 E1)) DX (- (CAR P2) (CAR P1)) DY (- (CADR P2) (CADR P1)) DZ (- (CADDR P2) (CADDR P1))) (IF (AND (/= DX 0.0) (SETQ M (/ DY DX)) (< (ABS M) 1.0e+010)) (PROGN (SETQ B (- (CADR P1) (* M (CAR P1))))) (SETQ M nil B (CAR P1))) (IF (AND M (EQUAL M 0.0 1.0e-008)) (PROGN (IF (AND (/= DX 0.0) (SETQ M2 (/ DZ DX)) (< (ABS M2) 1.0e+010)) (SETQ B2 (- (CADDR P1) (* M2 (CAR P1)))) (SETQ M2 nil B2 (CAR P1)))) (PROGN (IF (AND (/= DY 0.0) (SETQ M2 (/ DZ DY)) (< (ABS M2) 1.0e+010)) (SETQ B2 (- (CADDR P1) (* M2 (CADR P1)))) (SETQ M2 nil B2 (CADR P1))))) (IF M (SETQ M (ACET-CALC-ROUND M 1.0e-008))) (IF M2 (SETQ M2 (ACET-CALC-ROUND M2 1.0e-008))) (SETQ B (ACET-CALC-ROUND B FUZ) B2 (ACET-CALC-ROUND B2 FUZ)) (IF (SETQ TH (CDR (ASSOC 39 E1))) (SETQ XV (CDR (ASSOC 210 E1)) XV (MAPCAR (QUOTE (LAMBDA (X) (ACET-CALC-ROUND X 1.0e-008))) XV))) (IF XV (LIST 0 M B M2 B2 XV (ACET-OVERKILL-GEN-PROP-GET2 E1 GENPROPS)) (LIST 0 M B M2 B2 (ACET-OVERKILL-GEN-PROP-GET2 E1 GENPROPS))))
(DEFUN ACET-OVERKILL-GEN-PROP-GET2 (E1 GENPROPS / A LST) (FOREACH GCODE GENPROPS (IF (NOT (SETQ A (ASSOC GCODE E1))) (SETQ A (LIST GCODE))) (SETQ LST (CONS A LST))) LST)
(DEFUN ACET-RTOS2 (VAL / A B UNITS OLD_DIMZIN) (SETQ UNITS (GETVAR "lunits")) (IF (OR (= UNITS 4) (= UNITS 5)) (RTOS VAL) (PROGN (SETQ OLD_DIMZIN (GETVAR "dimzin")) (SETVAR "dimzin" (LOGAND OLD_DIMZIN (~ 8))) (SETQ A (RTOS VAL)) (SETVAR "dimzin" (LOGIOR OLD_DIMZIN 8)) (SETQ B (RTOS VAL UNITS 15)) (SETVAR "dimzin" OLD_DIMZIN) (IF (EQUAL (DISTOF A) (DISTOF B) 1.0e-014) A B))))
(DEFUN ACET-OVERKILL-SS->PRIMITIVES2 (SS FUZ IGNORE / FLT LST GCODE GENPROPS N NA E1 TP A B GEN C D XV VLST TMP ALST LST2 LST3 J LEN K) (ACET-SS-CLEAR-PREV) (COMMAND "_.select" SS) (WHILE (WCMATCH (GETVAR "cmdnames") "*SELECT*") (COMMAND "")) (SETQ FLT (QUOTE ((-4 . "<OR") (0 . "LINE") (0 . "ARC") (0 . "CIRCLE") (0 . "LWPOLYLINE") (-4 . "<AND") (0 . "POLYLINE") (-4 . "<NOT") (-4 . "&") (70 . 88) (-4 . "NOT>") (-4 . "AND>") (-4 . "OR>"))) SS (SSGET "_p" FLT)) (IF (NOT SS) (SETQ SS (SSADD))) (SETQ LST (QUOTE (8 6 39 62 370 390))) (FOREACH GCODE LST (IF (NOT (MEMBER GCODE IGNORE)) (SETQ GENPROPS (CONS GCODE GENPROPS)))) (SETQ LST nil) (SETQ LEN (SSLENGTH SS) K (/ LEN 5) J 1) (ACET-UI-PROGRESS-INIT "Gathering line, arc and circle data " LEN) (SETQ N 0) (REPEAT (SSLENGTH SS) (SETQ NA (SSNAME SS N) LST nil) (COND ((AND (SETQ E1 (ENTGET NA) TP (CDR (ASSOC 0 E1))) (= TP "LINE")) (SETQ A (CDR (ASSOC 10 E1)) B (CDR (ASSOC 11 E1)) LST (LIST A B NA) GEN (ACET-OVERKILL-LINE-DATA2 E1 FUZ GENPROPS))) ((OR (= TP "ARC") (= TP "CIRCLE")) (SETQ A (CDR (ASSOC 50 E1)) B (CDR (ASSOC 51 E1)) C (CDR (ASSOC 10 E1)) D (CDR (ASSOC 40 E1)) C (LIST (ACET-CALC-ROUND (CAR C) FUZ) (ACET-CALC-ROUND (CADR C) FUZ) (ACET-CALC-ROUND (CADDR C) FUZ)) D (ACET-CALC-ROUND D FUZ) XV (CDR (ASSOC 210 E1)) XV (LIST (ACET-CALC-ROUND (CAR XV) 1.0e-008) (ACET-CALC-ROUND (CADR XV) 1.0e-008) (ACET-CALC-ROUND (CADDR XV) 1.0e-008)) GEN (LIST 1 C D XV (ACET-OVERKILL-GEN-PROP-GET2 E1 GENPROPS))) (IF (NOT A) (SETQ A 0.0 B (+ PI PI))) (SETQ LST (LIST (CDR (ASSOC 10 E1)) (CDR (ASSOC 40 E1)) A B NA)))) (IF (= J K) (PROGN (ACET-UI-PROGRESS-SAFE (FIX (* 0.5 N))) (SETQ J 1)) (SETQ J (+ J 1))) (IF LST (SETQ VLST (CONS (LIST GEN LST) VLST))) (SETQ N (+ N 1))) (SETQ J (/ LEN 2)) (ACET-UI-PROGRESS-SAFE J) (SETQ VLST (VL-SORT VLST (QUOTE (LAMBDA (A B) (> (CAR (CAR A)) (CAR (CAR B))))))) (WHILE (AND (SETQ A (CAR VLST)) (= (CAR (CAR A)) 1)) (SETQ ALST (CONS A ALST) VLST (CDR VLST))) (SETQ J (+ J (FIX (* 0.05 LEN)))) (ACET-UI-PROGRESS-SAFE J) (SETQ VLST (VL-SORT VLST (QUOTE (LAMBDA (A B) (SETQ A (CAR A) B (CAR B)) (< (NTH 2 A) (NTH 2 B)))))) (SETQ J (+ J (FIX (* 0.2 LEN)))) (ACET-UI-PROGRESS-SAFE J) (SETQ ALST (VL-SORT ALST (QUOTE (LAMBDA (A B) (SETQ A (CAR A) B (CAR B)) (< (NTH 2 A) (NTH 2 B)))))) (SETQ J (+ J (FIX (* 0.1 LEN)))) (ACET-UI-PROGRESS-SAFE J) (WHILE (SETQ LST (CAR VLST)) (SETQ VLST (CDR VLST) A (NTH 2 (CAR LST)) LST2 (LIST LST)) (WHILE (AND (SETQ B (CAR VLST)) (EQUAL A (NTH 2 (CAR B)))) (SETQ VLST (CDR VLST) LST2 (CONS B LST2))) (SETQ LST3 (CONS LST2 LST3))) (SETQ J (+ J (FIX (* 0.05 LEN)))) (ACET-UI-PROGRESS-SAFE J) (SETQ VLST nil LST2 nil) (FOREACH LST LST3 (SETQ LST2 (ACET-LIST-GROUP-BY-ASSOC LST)) (IF (EQUAL 1 (LENGTH LST2)) (SETQ VLST (CONS (CAR LST2) VLST)) (SETQ VLST (APPEND LST2 VLST)))) (SETQ LST3 nil) (WHILE (SETQ LST (CAR ALST)) (SETQ ALST (CDR ALST) A (NTH 2 (CAR LST)) LST2 (LIST LST)) (WHILE (AND (SETQ B (CAR ALST)) (EQUAL A (NTH 2 (CAR B)))) (SETQ ALST (CDR ALST) LST2 (CONS B LST2))) (SETQ LST3 (CONS LST2 LST3))) (SETQ J (+ J (FIX (* 0.05 LEN)))) (ACET-UI-PROGRESS-SAFE J) (SETQ ALST nil LST2 nil) (FOREACH LST LST3 (SETQ LST2 (ACET-LIST-GROUP-BY-ASSOC LST)) (IF (EQUAL 1 (LENGTH LST2)) (SETQ ALST (CONS (CAR LST2) ALST)) (SETQ ALST (APPEND LST2 ALST)))) (ACET-UI-PROGRESS-DONE) (APPEND VLST ALST))
(PRINC)
