请高手们去掉源码中的注册代码

ilovem

网上看到的，可以排版套料，可惜要注册，请高手们帮忙去掉注册代码，看看是否真的那么好用，谢谢了。

(DEFUN MMMM11 (/    A10         A3   A4   A5        A6   A7          A8   AAA  DM         JX1
               JX2  JX3         JX4  JX5  JX6        MM   MM1  MM2  MM3  MM4         MM5
               MM6
              )
  (setq AAA (RTOS (GETVAR "CDATE")))
  (setq A3 (ATOF (SUBSTR AAA 12 1)))
  (setq A4 (ATOF (SUBSTR AAA 4 1)))
  (setq A5 (ATOF (SUBSTR AAA 5 1)))
  (setq A6 (ATOF (SUBSTR AAA 6 1)))
  (setq A7 (ATOF (SUBSTR AAA 7 1)))
  (setq A8 (ATOF (SUBSTR AAA 8 1)))
  (setq A10 (ATOF (SUBSTR AAA 11 1)))
  (setq JX1 (+ 1 (REM (* (FIX (ABS (+ A3 A3 A4))) 369) 26)))
  (setq JX2 (+ 1 (REM (* (FIX (ABS (+ A4 A3 A5))) 963) 26)))
  (setq JX3 (+ 1 (REM (* (FIX (ABS (+ A5 A3 A6))) 365) 26)))
  (setq JX4 (+ 1 (REM (* (FIX (ABS (+ A6 A3 A7))) 563) 26)))
  (setq JX5 (+ 1 (REM (* (FIX (ABS (+ A7 A3 A8))) 831) 26)))
  (setq JX6 (+ 1 (REM (* (FIX (ABS (+ A8 A3 A10))) 138) 26)))
  (setq        DM (LIST "a"   "b"   "c"   "d"         "e"   "f"   "g"   "h"         "i"
                 "j"   "k"   "l"   "m"         "n"   "o"   "p"   "q"         "r"
                 "s"   "t"   "u"   "v"         "w"   "x"   "y"   "z"         "z"
                )
  )
  (setq MM1 (NTH JX1 DM))
  (setq MM2 (NTH JX2 DM))
  (setq MM3 (NTH JX3 DM))
  (setq MM4 (NTH JX4 DM))
  (setq MM5 (NTH JX5 DM))
  (setq MM6 (NTH JX6 DM))
  (setq MMMM (STRCAT MM1 MM2 MM3 MM4 MM5 MM6))
)
(VL-LOAD-COM)
(setq *ACAD* (vlax-get-acad-object))
(setq *DOC* (vla-get-ActiveDocument *ACAD*))
(DEFUN DXF (N DATA) (CDR (ASSOC N DATA)))
(DEFUN DXF2 (DXF LST) (CADR (ASSOC DXF LST)))
(DEFUN SSUBST (NEW_LST OLD_LST / OLD A)
  (setq
    OLD        (VL-REMOVE-IF '(LAMBDA (A) (ASSOC (CAR A) NEW_LST)) OLD_LST)
  )
  (APPEND OLD NEW_LST)
)
(DEFUN ENDXF (DXF EN) (CDR (ASSOC DXF (ENTGET EN))))
(DEFUN KOSGET (STR) (ENTGET (CAR (ENTSEL STR))))
(DEFUN KOSSGET (I) (ENTGET (SSNAME (SSGET) I)))
(DEFUN VLASEL ()
  (vlax-ename->vla-object (SSNAME (SSGET) 0))
)
(DEFUN ENA->VLA        (ENA)
  (VL-LOAD-COM)
  (vlax-ename->vla-object ENA)
)
(DEFUN CAR2 (LST) (CADR LST))
(DEFUN CAR3 (LST) (CADDR LST))
(DEFUN CAR4 (LST) (CADDDR LST))
(DEFUN CMD0 () (SETVAR "cmdecho" 0))
(DEFUN CMD1 () (SETVAR "cmdecho" 1))
(DEFUN CMDBE ()
  (SETVAR "cmdecho" 0)
  (command "._undo")
  (command "be")
)
(DEFUN UNDOM ()
  (SETVAR "cmdecho" 0)
  (command ".undo")
  (command "m")
)
(DEFUN UNDOB ()
  (SETVAR "cmdecho" 0)
  (command ".undo")
  (command "b")
)
(DEFUN CMDE ()
  (SETVAR "cmdecho" 0)
  (command "._undo")
  (command "e")
  (SETVAR "cmdecho" 1)
)
(DEFUN MAXLIST (LST) (APPLY 'MAX LST))
(DEFUN DTOR (D) (* (ATOF D) (/ PI 180.0)))
(DEFUN RTOD (PII S) (ANGTOS PII 0 S))
(DEFUN #KOERR (S) (setq *ERROR* $OERR) (PRINC))
(DEFUN NUM->STR        (NUM / STR)
  (if (NUMBERP NUM)
    (PROGN (setq STR (vlax-variant-change-type (vlax-make-variant NUM) 8))
           (setq STR (vlax-variant-value STR))
           (setq STR (if (= (ASCII STR) 46)
                       (PROGN (STRCAT "0" STR))
                       (PROGN STR)
                     )
           )
    )
    (PROGN "")
  )
)
(DEFUN KO->UCS-INIT ()
  (if (/= 1 (GETVAR "WORLDUCS"))
    (PROGN (SETVAR "cmdecho" 0)
           (setq UCSFLAG T)
           (command "_.ucs")
           (command "w")
    )
    (PROGN (setq UCSFLAG nil))
  )
)
(DEFUN KO->OSOFF ()
  (setq $OS (GETVAR "osmode"))
  (SETVAR "osmode" 0)
)
(DEFUN KO->OSON () (SETVAR "osmode" $OS) (setq $OS nil))
(DEFUN KO->SNAPOFF () (SETVAR "AUTOSNAP" 55))
(DEFUN KO->SNAPON () (SETVAR "AUTOSNAP" 63))
(DEFUN KO->TAN (THITA) (/ (SIN THITA) (COS THITA)))
(DEFUN KO-CHECK-TYPEOFNUM (X) (= (* 2.0 (FIX (/ X 2.0))) X))
(DEFUN KO->UCS-RESTORE ()
  (if UCSFLAG
    (PROGN (command "_.ucs") (command "p"))
  )
  (setq UCSFLAG nil)
)
(DEFUN ERRORMSG        ()
  (setq        $KO-ERRORMSG$
         '(IF
           (= MSG "函数被取消")
           (SETQ
            MSG
            "\n鬼谷子温馨提示:你用Esc键中止了程序,谢谢使用!!!"
           )
          )
  )
)
(DEFUN KO-MAKE-LINE (PT1 PT2 LAY)
  (ENTMAKE (LIST '(0 . "LINE")
                 '(100 . "AcDbEntity")
                 '(100 . "AcDbLine")
                 (CONS 8 LAY)
                 (CONS 10 PT1)
                 (CONS 11 PT2)
           )
  )
)
(DEFUN KO->LOADSLD (KEY SLD / X Y)
  (setq X (DIMX_TILE KEY))
  (setq Y (DIMY_TILE KEY))
  (START_IMAGE KEY)
  (FILL_IMAGE 0 0 X Y -2)
  (SLIDE_IMAGE 0 0 X Y SLD)
  (END_IMAGE)
)
(DEFUN KO->SS-2LST (SS / AA)
  (if SS
    (PROGN (setq AA '(LAMBDA (X) (= (TYPE X) (QUOTE ENAME))))
           (VL-REMOVE-IF-NOT AA (MAPCAR 'CADR (SSNAMEX SS)))
    )
  )
)
(DEFUN KO-PASSWORD-OK (PASSSTR           TIL_STR     SHOWMSG           /
                       MAKE_DCL_FILE               DCLNAME           FILEN
                       DCLID           MODETILE    DATA_GET           DATA_SET
                       ACTION           NOTEXIT     OK_INDEX
                      )
  (DEFUN MAKE_DCL_FILE ()
    (setq TEMPNAME (VL-FILENAME-MKTEMP "ko-dcl-tmp.dcl"))
    (setq DCLNAME
           (COND
             ((setq FILEN (OPEN TEMPNAME "w"))
              (FOREACH STREAM
                       (APPLY
                         'APPEND
                         (LIST (LIST "\n"
                                     "pass:dialog {\n"
                                     (STRCAT "    label = \""
                                             TIL_STR
                                             "\" ;\n"
                                     )
                                     "    :text {\n"
                                     (STRCAT "        label = \""
                                             SHOWMSG
                                             "\" ;\n"
                                     )
                                     "    }\n"
                                     "    :edit_box {\n"
                                     "        key = \"password\" ;\n"
                                     "    }\n"
                                     "    ok_cancel;\n"
                                     "}\n"
                               )
                         )
                       )
                (PRINC STREAM FILEN)
              )
              (CLOSE FILEN)
              TEMPNAME
             )
           )
    )
  )
  (DEFUN MODETILE () (MODE_TILE "password" 2))
  (DEFUN DATA_GET () nil)
  (DEFUN CHECK_OK ()
    (if        (AND (= PASSSTR (GET_TILE "password"))
             (/= "" (VL-STRING-TRIM " " (GET_TILE "password")))
        )
      (PROGN (setq OK_INDEX T) (DONE_DIALOG))
      (PROGN (ALERT "口令密码不对，请重新输入或单击取消退出"))
    )
  )
  (DEFUN DATA_SET ()
    (if        (NOT (NEW_DIALOG "pass" DCLID))
      (PROGN (ALERT "dcl对话框加载失败.") (VL-EXIT-WITH-ERROR ""))
    )
    (VL-FILE-DELETE DCLNAME)
    (ACTION)
    (MODETILE)
    (START_DIALOG)
  )
  (DEFUN ACTION        (/ A)
    (FOREACH A '("accept")
      (ACTION_TILE
        A
        (STRCAT "(setq lastcmd \"" A "\")(check_ok))")
      )
    )
    (ACTION_TILE
      "cancel"
      "(setq lastcmd \"cancel\")(done_dialog)"
    )
  )
  (MAKE_DCL_FILE)
  (setq DCLID (LOAD_DIALOG DCLNAME))
  (DATA_SET)
  (setq NOTEXIT T)
  (while (and NOTEXIT)
    (COND ((= LASTCMD "accept") (setq NOTEXIT nil))
          ((= LASTCMD "cancel") (setq NOTEXIT nil))
          (T (setq NOTEXIT nil))
    )
  )
  (UNLOAD_DIALOG DCLID)
  OK_INDEX
)
(DEFUN KO->LST-2SS (LST / N SS)
  (setq SS (SSADD))
  (FOREACH N LST
    (if        (= (TYPE N) 'ENAME)
      (PROGN (setq SS (SSADD N SS)))
    )
  )
  SS
)
(DEFUN KO-SIN-BOUND
       (ENT / I OBJ PTA PTB DWCORN UPCORN PTLIST X Y LST P1 P2 ANG)
  (setq OBJ (vlax-ename->vla-object ENT))
  (setq        OBJ (VL-CATCH-ALL-APPLY
              'vla-GetBoundingBox
              (LIST OBJ 'PTA 'PTB)
            )
  )
  (if (= nil (VL-CATCH-ALL-ERROR-P OBJ))
    (PROGN
      (LIST (vlax-safearray->list PTA) (vlax-safearray->list PTB))
    )
    (PROGN
      (setq LST (ENTGET ENT))
      (setq ANG (CADR (CDR (ASSOC 11 LST))))
      (setq PTA (CDR (ASSOC 10 LST)))
      (if (= nil ANG)
        (PROGN (LIST (LIST (MIN (CAR PTA) (CAR PTA))
                           (MIN (CADR PTA) (CADR PTA))
                           0
                     )
                     (LIST (MAX (CAR PTA) (CAR PTA))
                           (MAX (CADR PTA) (CADR PTA))
                           0
                     )
               )
        )
        (PROGN
          (setq        P1 (LIST (- (CAR PTA) (* 300 (COS ANG)))
                         (- (CADR PTA) (* 300 (SIN ANG)))
                   )
          )
          (setq        P2 (LIST (+ (CAR PTA) (* 300 (COS ANG)))
                         (+ (CADR PTA) (* 300 (SIN ANG)))
                   )
          )
          (LIST
            (LIST (MIN (CAR P1) (CAR P2)) (MIN (CADR P1) (CADR P2)) 0)
            (LIST (MAX (CAR P1) (CAR P2)) (MAX (CADR P1) (CADR P2)) 0)
          )
        )
      )
    )
  )
)
(DEFUN KO-ISCLOSED (POLY)
  (= 1 (LOGAND 1 (CDR (ASSOC 70 (ENTGET POLY)))))
)
(DEFUN KO-MYPRIN (STR / N) (MAPCAR 'PRINC STR))
(DEFUN KO-GET->LIST-ATPLINEPOINT (ENA         BF        /      LST    SS
                                  EN2         LST        LST2   ENAEDATE
                                  COORDS 10LST        BLUES  42LST  LLST
                                  REP         X
                                 )
  (DEFUN REP (LS / INDEX LST I I_INDEX PTLST PT)
    (setq LST LS)
    (setq INDEX 0)
    (while (and (AND LST (setq I (CAR LST))))
      (COND
        ((AND BF (NULL (ZEROP (LAST I))))
         (setq I_INDEX INDEX)
         (while
           (and        (AND (NULL (EQUAL I_INDEX (+ 1 INDEX) 1.0e-005))
                     (setq PT (vlax-curve-getPointAtParam ENA I_INDEX))
                )
           )
            (setq PTLST (CONS PT PTLST))
            (setq I_INDEX (+ I_INDEX (/ 1.0 BF)))
         )
        )
        ((ZEROP (LAST I)) (setq PTLST (CONS (CAR I) PTLST)))
      )
      (setq INDEX (1+ INDEX))
      (setq LST (CDR LST))
    )
    PTLST
  )
  (setq EDATE (ENTGET ENA))
  (if (= (DXF 0 EDATE) "LWPOLYLINE")
    (PROGN (setq COORDS
                  (VL-REMOVE-IF-NOT '(LAMBDA (X) (EQUAL (CAR X) 10)) EDATE)
           )
           (setq 10LST (MAPCAR 'CDR COORDS))
           (setq BLUES
                  (VL-REMOVE-IF-NOT '(LAMBDA (X) (EQUAL (CAR X) 42)) EDATE)
           )
           (setq 42LST (MAPCAR 'CDR BLUES))
           (setq LLST (MAPCAR 'LIST 10LST 42LST))
           (if (KO-ISCLOSED ENA)
             (PROGN
               (REVERSE (CONS (vlax-curve-getStartPoint ENA) (REP LLST)))
             )
             (PROGN (REVERSE (REP LLST)))
           )
    )
  )
)
(DEFUN KO->LST-DELLXSAME (LST1 / I E LST2)
  (setq I 0)
  (setq E nil)
  (while (and LST1)
    (if        (NOT (EQUAL E (CAR LST1)))
      (PROGN (setq LST2 (CONS (CAR LST1) LST2)))
    )
    (setq E (CAR LST1))
    (setq LST1 (CDR LST1))
  )
  (REVERSE LST2)
)
(DEFUN KO-GET->LIST-SSBOX (SS            VAL-MODE /              I               XDIR
                           YDIR            ZDIR     ORIG     WORG     ISWCS
                           VXV            TRP             MXV      MXM      MATLST
                           MATRIX   REVMAT   SEL      ENT      OBJ
                           MINPT    SSS             WT              WCS      MAXPT
                           MINLS    MAXLS    MAXX     MAXY     MINX
                           MINY            PT1             PT2      LST      CMDMOD
                           VDIR            VMAT     VTWIST   GETMATRIX
                           MAKE-RECTANGE     G:CROSSPRODUCTOR
                          )
  (DEFUN GETMATRIX (LST ORG REVFLAG / MAT I J)
    (setq MAT (vlax-make-safearray 5 '(0 . 3) '(0 . 3)))
    (setq I 0)
    (REPEAT 3
      (vlax-safearray-put-element MAT I 3 (NTH I ORG))
      (setq J 0)
      (REPEAT 3
        (if REVFLAG
          (PROGN
            (vlax-safearray-put-element MAT I J (NTH J (NTH I LST)))
          )
          (PROGN
            (vlax-safearray-put-element MAT I J (NTH I (NTH J LST)))
          )
        )
        (setq J (1+ J))
      )
      (setq I (1+ I))
    )
    (vlax-safearray-put-element MAT 3 3 1.0)
    MAT
  )
  (DEFUN MAKE-RECTANGE (PT1 PT2)
    (ENTMAKE (LIST '(0 . "LWPOLYLINE")
                   '(100 . "AcDbEntity")
                   '(100 . "AcDbPolyline")
                   '(90 . 4)
                   '(70 . 1)
                   (CONS 38 (CADDR PT1))
                   (CONS 10 (LIST (CAR PT1) (CADR PT1)))
                   (CONS 10 (LIST (CAR PT2) (CADR PT1)))
                   (CONS 10 (LIST (CAR PT2) (CADR PT2)))
                   (CONS 10 (LIST (CAR PT1) (CADR PT2)))
                   (CONS 210 '(0 0 1))
             )
    )
  )
  (DEFUN G:CROSSPRODUCTOR (VEC1 VEC2 / A B C D E F)
    (setq A (CAR VEC1))
    (setq B (CADR VEC1))
    (setq C (CADDR VEC1))
    (setq D (CAR VEC2))
    (setq E (CADR VEC2))
    (setq F (CADDR VEC2))
    (LIST (- (* B F) (* C E))
          (- (* C D) (* A F))
          (- (* A E) (* B D))
    )
  )
  (DEFUN VXV (V1 V2) (APPLY '+ (MAPCAR '* V1 V2)))
  (DEFUN TRP (M) (APPLY 'MAPCAR (CONS 'LIST M)))
  (DEFUN MXV (M V) (MAPCAR '(LAMBDA (R) (VXV R V)) M))
  (DEFUN MXM (M Q) (MAPCAR '(LAMBDA (R) (MXV (TRP Q) R)) M))
  (COND        ((= (TYPE SS) 'PICKSET))
        ((= (TYPE SS) 'ENAME)
         (setq SSS (SSADD))
         (setq SS (SSADD SS SSS))
        )
  )
  (setq ISWCS (GETVAR "WORLDUCS"))
  (setq WCS ISWCS)
  (setq VTWIST (GETVAR "VIEWTWIST"))
  (setq VT VTWIST)
  (COND        ((/= VTWIST 0)
         (setq VDIR (GETVAR "VIEWDIR"))
         (setq VMAT (MXM (LIST (TRANS '(1.0 0.0 0.0) 0 VDIR T)
                               (TRANS '(0.0 1.0 0.0) 0 VDIR T)
                               (TRANS '(0.0 0.0 1.0) 0 VDIR T)
                         )
                         (LIST (LIST (COS VTWIST) (- (SIN VTWIST)) 0.0)
                               (LIST (SIN VTWIST) (COS VTWIST) 0.0)
                               (LIST 0.0 0.0 1.0)
                         )
                    )
         )
         (setq MATRIX (GETMATRIX VMAT '(0 0 0) nil))
         (setq REVMAT (GETMATRIX VMAT '(0 0 0) T))
        )
        ((= ISWCS 0)
         (setq XDIR (GETVAR "UCSXDIR"))
         (setq YDIR (GETVAR "UCSYDIR"))
         (setq ZDIR (G:CROSSPRODUCTOR XDIR YDIR))
         (setq ORIG (GETVAR "UCSORG"))
         (setq WORG (TRANS '(0 0 0) 0 1))
         (setq MATLST (LIST XDIR YDIR ZDIR))
         (setq MATRIX (GETMATRIX MATLST ORIG nil))
         (setq REVMAT (GETMATRIX MATLST WORG T))
        )
        (T (setq ISWCS nil) (setq VTWIST nil))
  )
  (setq CMDMOD (GETVAR "CMDECHO"))
  (SETVAR "CMDECHO" 0)
  (command "UNDO")
  (command "BE")
  (if SS
    (PROGN
      (setq I 0)
      (setq MINPT (vlax-make-safearray 5 '(0 . 2)))
      (setq MAXPT (vlax-make-safearray 5 '(0 . 2)))
      (REPEAT (SSLENGTH SS)
        (setq ENT (SSNAME SS I))
        (setq OBJ (vlax-ename->vla-object ENT))
        (COND ((AND (= VTWIST 0) (= ISWCS 0)))
              (T (AND (OR VTWIST ISWCS) (vla-TransformBy OBJ REVMAT)))
        )
        (vla-GetBoundingBox OBJ 'MINPT 'MAXPT)
        (setq MINPT (vlax-safearray->list MINPT))
        (setq MAXPT (vlax-safearray->list MAXPT))
        (setq MINLS (CONS MINPT MINLS))
        (setq MAXLS (CONS MAXPT MAXLS))
        (COND ((AND (= VTWIST 0) (= ISWCS 0)))
              (T (AND (OR ISWCS VTWIST) (vla-TransformBy OBJ MATRIX)))
        )
        (setq I (1+ I))
      )
      (setq MINX (APPLY 'MIN (MAPCAR 'CAR MINLS)))
      (setq MINY (APPLY 'MIN (MAPCAR 'CADR MINLS)))
      (setq MAXX (APPLY 'MAX (MAPCAR 'CAR MAXLS)))
      (setq MAXY (APPLY 'MAX (MAPCAR 'CADR MAXLS)))
      (setq PT1 (LIST MINX MINY 0))
      (setq PT2 (LIST MAXX MAXY 0))
      (MAKE-RECTANGE PT1 PT2)
      (COND ((AND (= WCS 1) (= VT 0)))
            ((OR (/= ISWCS 0) (/= VTWIST 0))
             (vla-TransformBy (vlax-ename->vla-object (ENTLAST)) MATRIX)
            )
      )
      (setq LST (KO-GET->LIST-ATPLINE (ENTLAST)))
      (setq LST (REVERSE (CDR (REVERSE LST))))
      (setq LST (MAPCAR '(LAMBDA (X) (TRANS X 0 1)) LST))
      (if (NULL VAL-MODE)
        (PROGN (command "erase") (command (ENTLAST)) (command ""))
      )
    )
  )
  (command "UNDO")
  (command "E")
  (SETVAR "CMDECHO" CMDMOD)
  (if VAL-MODE
    (PROGN (PRINC))
    (PROGN LST)
  )
)
(DEFUN KO-GET->LIST-ATPLINE (ENA / EDATE COORDS LST CMD)
  (setq CMD (GETVAR "cmdecho"))
  (SETVAR "cmdecho" 0)
  (setq ENA (KO-CONVERT-PLINE ENA))
  (setq EDATE (ENTGET ENA))
  (if (= (DXF 0 EDATE) "LWPOLYLINE")
    (PROGN (setq COORDS
                  (VL-REMOVE-IF-NOT '(LAMBDA (X) (EQUAL (CAR X) 10)) EDATE)
           )
           (setq LST (MAPCAR 'CDR COORDS))
    )
  )
  (SETVAR "cmdecho" CMD)
  (if (KO-ISCLOSED ENA)
    (PROGN (APPEND LST (LIST (CAR LST))))
    (PROGN LST)
  )
)
(DEFUN KO-CONVERT-PLINE        (ENA / PE)
  (SETVAR "cmdecho" 0)
  (if (= (CDR (ASSOC 0 (ENTGET ENA))) "POLYLINE")
    (PROGN (setq PE (GETVAR "peditaccept"))
           (SETVAR "peditaccept" 0)
           (if (= (GETVAR "plinetype") 0)
             (PROGN (SETVAR "plinetype" 2))
           )
           (command "explode")
           (command ENA)
           (setq ENA (SSGET "p"))
           (command "._pedit")
           (command "M")
           (command ENA)
           (command "")
           (command "Y")
           (command "J")
           (command "0.5")
           (command "")
           (ENTLAST)
    )
    (PROGN ENA)
  )
)
(DEFUN KO->SSSUM (SS1 SS2)
  (SETVAR "cmdecho" 0)
  (if SS1
    (PROGN (if SS2
             (PROGN (VL-CMDF "._select" SS1 SS2 "") (SSGET "p"))
             (PROGN SS1)
           )
    )
    (PROGN (if SS2
             (PROGN SS2)
           )
    )
  )
)
(DEFUN KO->SUBLIST (LST PT SZ / LEN WZ I LST1)
  (setq LEN (LENGTH LST))
  (if (OR (= SZ nil) (> SZ LEN))
    (PROGN (setq SZ (+ (- LEN PT) 1)))
  )
  (setq WZ PT)
  (setq I 0)
  (setq LST1 nil)
  (REPEAT SZ
    (setq LST1 (APPEND (LIST (NTH WZ LST)) LST1))
    (setq WZ (1+ WZ))
    (setq I (1+ I))
  )
  (VL-REMOVE nil (REVERSE LST1))
)
(DEFUN KO->LST-2FILE (LST FILENAME MODE / F1 STR)
  (if (setq F1 (OPEN FILENAME MODE))
    (PROGN (while (and (setq STR (CAR LST)))
             (WRITE-LINE STR F1)
             (setq LST (CDR LST))
           )
           (CLOSE F1)
           T
    )
  )
)
(DEFUN KO-ZOOMSCALED (SCALEVAL)
  (vla-ZoomScaled
    (vlax-get-acad-object)
    SCALEVAL
    acZoomScaledRelative
  )
)
(vl-ACAD-defun
  (DEFUN C:WwW (/              BOX_ENLST             BOX_SS
               B_PT              EN             HI_BASE
               H_INT_DIS      LST             P
               SORT_SS              SORT_WI_LST    SSS
               S_PTLST              V_INT_DIS             WI
               X              Y_BASE             MODEL_ACTION
               EVAL_FUN              KOALERT             REP_SORT_BOX
               BOX_SORT              GO_COPY             REP_SOTRT_ONEBOX
               CHECK_NI              GET_ALL_SORT_INSERT
               GET_ALL_SORT_WITH             X_SORT
               GET_SS_INHAVE  2/3ENA             GET_INHAVE_ENA
               KOKO-SIN-BOUND CHECK_NUM_SAME ONLINE_SS
               LEFT_BASE      FIND_IN_LINE_ENLST
               OK_SORT_ENLST
              )
    (DEFUN KOKO-SIN-BOUND (ENA / LLST)
      (setq LLST (KO-SIN-BOUND ENA))
      (LIST (CAR LLST)
            (LIST (CAR (LAST LLST)) (CADR (CAR LLST)) 0.0)
            (LAST LLST)
            (LIST (CAR (CAR LLST)) (CADR (LAST LLST)) 0.0)
      )
    )
    (DEFUN FIND_IN_LINE_ENLST (/ AU ENLST X N SSENLST OK)
      (setq SSENLST (KO->SS-2LST SORT_SS))
      (setq OK (LENGTH SSENLST))
      (setq N -1)
      (while (and (CAR SSENLST))
        (setq N (1+ N))
        (AND (setq ENLST (ONLINE_SS (CAR SSENLST)))
             (setq OK_SORT_ENLST
                    (APPLY 'APPEND (LIST ENLST OK_SORT_ENLST))
             )
        )
        (setq SSENLST (CDR SSENLST))
        (KO-MYPRIN (LIST "\n"
                         "已完成..."
                         (RTOS (* (/ (FLOAT (1+ N)) OK) 100) 2 1)
                         "%"
                   )
        )
      )
      (AND OK_SORT_ENLST
           (setq OK_SORT_ENLST
                  (VL-REMOVE-IF
                    '(LAMBDA (X) (MEMBER X OK_SORT_ENLST))
                    (KO->SS-2LST SORT_SS)
                  )
           )
      )
    )
    (DEFUN GET_INHAVE_ENA (ENA / LST EN SS)
      (setq LST (KO-GET->LIST-ATPLINE ENA))
      (setq SS (SSGET "wp" (KO->LST-DELLXSAME LST)))
      (if SS
        (PROGN SS)
      )
    )
    (DEFUN ONLINE_SS (ENA / LST EN SS EN2 LST)
      (command "._offset")
      (command 1)
      (command ENA)
      (command "non")
      (command (MAPCAR '+ LEFT_BASE '(-10 -10 0.0)))
      (command "")
      (setq EN (ENTLAST))
      (setq LST (KO-GET->LIST-ATPLINEPOINT EN 35))
      (vla-Delete (vlax-ename->vla-object EN))
      (setq SS (SSGET "wp" (KO->LST-DELLXSAME LST)))
      (if SS
        (PROGN (VL-REMOVE ENA (KO->SS-2LST SS)))
      )
    )
    (DEFUN 2/3ENA (HI ENA / LST DIS)
      (setq LST (KOKO-SIN-BOUND ENA))
      (setq DIS (DISTANCE (CAR LST) (LAST LST)))
      (AND (>= DIS (/ (* HI 2) 3)))
    )
    (DEFUN GET_SS_INHAVE (/ LST X)
      (setq LST (KO-GET->LIST-SSBOX (KO->SSSUM SORT_SS BOX_SS) nil))
      (command "zoom")
      (command "w")
      (command (CAR LST))
      (command (CADDR LST))
      (KO-ZOOMSCALED 0.97)
      (setq LST (KO-GET->LIST-SSBOX SORT_SS nil))
      (setq LEFT_BASE (CAR LST))
      (setq HI_BASE (DISTANCE (CAR LST) (LAST LST)))
      (setq Y_BASE (CADR (CAR LST)))
      (FIND_IN_LINE_ENLST)
    )
    (DEFUN X_SORT (/ E1 E2)
      (setq OK_SORT_ENLST
             (VL-SORT OK_SORT_ENLST
                      '(LAMBDA (E1 E2)
                         (< (CAR (CAR (KOKO-SIN-BOUND E1)))
                            (CAR (CAR (KOKO-SIN-BOUND E2)))
                         )
                       )
             )
      )
    )
    (DEFUN GET_ALL_SORT_WITH (/ X LST DIS)
      (setq SORT_WI_LST
             (MAPCAR '(LAMBDA (X)
                        (SETQ LST (KOKO-SIN-BOUND X))
                        (DISTANCE (CAR LST) (CADR LST))
                      )
                     OK_SORT_ENLST
             )
      )
    )
    (DEFUN GET_ALL_SORT_INSERT (/ X LST DIS)
      (setq S_PTLST (MAPCAR '(LAMBDA (X)
                               (SETQ LST (KOKO-SIN-BOUND X))
                               (LIST (CAR (CAR LST)) Y_BASE 0.0)
                             )
                            OK_SORT_ENLST
                    )
      )
    )
    (DEFUN CHECK_NI (WI SORT_WI / ONE S_WI I)
      (setq S_WI SORT_WI)
      (setq ONE (CAR S_WI))
      (setq I 0)
      (while (and (AND S_WI (<= ONE WI)))
        (setq S_WI (CDR S_WI))
        (setq I (1+ I))
        (setq ONE (if S_WI
                    (PROGN (+ ONE H_INT_DIS (CAR S_WI)))
                  )
        )
      )
      (if (ZEROP I)
        (PROGN nil)
        (PROGN (- I 1))
      )
    )
    (DEFUN REP_SOTRT_ONEBOX (BOX    /           LST          INSERT_PT        HI
                             WITH   S_WI   A          B         C        MOD
                             INDEX  B_LST  B_HI          GO_COPY
                            )
      (DEFUN GO_COPY (AA BB CC PT / P B_PT EN WI SSS)
        (setq P PT)
        (MAPCAR        '(LAMBDA (B_PT EN WI)
                   (IF (SETQ SSS (ONLINE_SS EN))
                     (COMMAND ".copy" EN (KO->LST-2SS SSS) "" B_PT P)
                     (COMMAND ".copy" EN "" B_PT P)
                   )
                   (SETQ P (POLAR P 0 (+ WI H_INT_DIS)))
                 )
                AA
                BB
                CC
        )
      )
      (setq LST (KOKO-SIN-BOUND BOX))
      (setq INSERT_PT (CAR LST))
      (setq HI (DISTANCE (CAR LST) (LAST LST)))
      (setq WITH (DISTANCE (CAR LST) (CADR LST)))
      (setq MOD T)
      (while (and (AND MOD
                       SORT_WI_LST
                       (setq INDEX (CHECK_NI WITH SORT_WI_LST))
                  )
             )
        (setq A (KO->SUBLIST S_PTLST 0 (+ 1 INDEX)))
        (setq B (KO->SUBLIST OK_SORT_ENLST 0 (+ 1 INDEX)))
        (setq C (KO->SUBLIST SORT_WI_LST 0 (+ 1 INDEX)))
        (setq B_LST (KO-GET->LIST-SSBOX (KO->LST-2SS B) nil))
        (setq B_HI (- (CADR (LAST B_LST)) Y_BASE))
        (if (<= B_HI HI)
          (PROGN
            (GO_COPY A B C INSERT_PT)
            (setq HI (- HI B_HI V_INT_DIS))
            (setq INSERT_PT (LIST (CAR INSERT_PT)
                                  (+ (CADR INSERT_PT) B_HI V_INT_DIS)
                                  0.0
                            )
            )
            (setq SORT_WI_LST (KO->SUBLIST SORT_WI_LST (+ INDEX 1) nil))
            (setq OK_SORT_ENLST
                   (KO->SUBLIST OK_SORT_ENLST (+ INDEX 1) nil)
            )
            (setq S_PTLST (KO->SUBLIST S_PTLST (+ INDEX 1) nil))
          )
          (PROGN (setq MOD nil))
        )
      )
    )
    (DEFUN BOX_SORT (/ E1 E2 LST)
      (setq BOX_ENLST (KO->SS-2LST BOX_SS))
      (setq BOX_ENLST (VL-SORT BOX_ENLST
                               '(LAMBDA        (E1 E2)
                                  (< (CAR (CAR (KOKO-SIN-BOUND E1)))
                                     (CAR (CAR (KOKO-SIN-BOUND E2)))
                                  )
                                )
                      )
      )
    )
    (DEFUN CHECK_NUM_SAME ()
      (if (NULL
            (APPLY
              '=
              (MAPCAR 'LENGTH (LIST OK_SORT_ENLST SORT_WI_LST S_PTLST))
            )
          )
        (PROGN (VL-EXIT-WITH-ERROR " "))
      )
    )
    (DEFUN REP_SORT_BOX        ()
      (while (and (AND BOX_ENLST OK_SORT_ENLST SORT_WI_LST S_PTLST))
        (REP_SOTRT_ONEBOX (CAR BOX_ENLST))
        (setq BOX_ENLST (CDR BOX_ENLST))
      )
      (AND OK_SORT_ENLST
           (ALERT "你提供的框不足够排完立面，特此公告！！！")
      )
    )
    (DEFUN KOALERT (STR) (ALERT STR))
    (DEFUN EVAL_FUN (FUN)
      (if (VL-CATCH-ALL-ERROR-P (VL-CATCH-ALL-APPLY FUN))
        (PROGN (KOALERT        (STRCAT        "对函数 <<"
                                (VL-PRINC-TO-STRING FUN)
                                ">> 求值时出错，请检查！"
                        )
               )
               (VL-EXIT-WITH-ERROR)
        )
      )
    )
    (DEFUN MODEL_ACTION        ()
      (SETVAR "cmdecho" 0)
      (SETVAR "osmode" 0)
      (MAPCAR 'EVAL_FUN
              '(GET_SS_INHAVE            X_SORT
                GET_ALL_SORT_WITH   GET_ALL_SORT_INSERT
                BOX_SORT            CHECK_NUM_SAME
                REP_SORT_BOX
               )
      )
      (SETVAR "osmode" 4775)
    )
    (DEFUN DLG_BOOT (/                  DCLID               DCLNAME
                     FILEN          KEY_LST      LASTCMD
                     NOTEXIT          TEMPNAME     ACTION
                     MAIN          DATA_SET     DATA_GET
                     CHECK_OKOK          GET_BOX_SS   GET_SORT_SS
                     MODETILE          MAKE_DCL_FILE
                    )
      (DEFUN MAKE_DCL_FILE ()
        (setq TEMPNAME (VL-FILENAME-MKTEMP "ko-dcl-tmp.dcl"))
        (setq DCLNAME
               (COND
                 ((setq FILEN (OPEN TEMPNAME "w"))
                  (FOREACH STREAM
                           (APPLY
                             'APPEND
                             (LIST
                               (LIST
                                 "autopl:dialog {\n"
                                 "    label = \"自动排列分割立面程序\" ;\n"
                                 "    :row {\n"
                                 "        :text {\n"
                                 "            label = \"水平距离：\" ;\n"
                                 "        }\n"
                                 "        :text {\n"
                                 "            label = \"垂直距离\" ;\n"
                                 "        }\n"
                                 "    }\n"
                                 "    :row {\n"
                                 "        :edit_box {\n"
                                 "            key = \"h\" ;\n"
                                 "        }\n"
                                 "        :edit_box {\n"
                                 "            key = \"v\" ;\n"
                                 "        }\n"
                                 "    }\n"
                                 "    :row {\n"
                                 "        label = \"选择\" ;\n"
                                 "        :button {\n"
                                 "            fixed_height = true ;\n"
                                 "            height = 3 ;\n"
                                 "            key = \"sort_ss\" ;\n"
                                 "            label = \"排序对象\" ;\n"
                                 "        }\n"
                                 "        :button {\n"
                                 "            fixed_height = true ;\n"
                                 "            height = 3 ;\n"
                                 "            key = \"box_ss\" ;\n"
                                 "            label = \"排序外框\" ;\n"
                                 "        }\n"
                                 "    }\n"
                                 "    :text {\n"
                                 "    }\n"
                                 "    ok_cancel;\n"
                                 "    :text{label=\"程序制作: QQ:119217161\";is_enabled = false;}\n"
                                 "}\n"
                                )
                             )
                           )
                    (PRINC STREAM FILEN)
                  )
                  (CLOSE FILEN)
                  TEMPNAME
                 )
               )
        )
      )
      (DEFUN MODETILE () nil)
      (DEFUN GET_SORT_SS ()
        (setq SORT_SS (SSGET '((0 . "*POLYLINE"))))
        (DATA_SET)
      )
      (DEFUN GET_BOX_SS        ()
        (setq BOX_SS (SSGET '((0 . "*POLYLINE"))))
        (DATA_SET)
      )
      (DEFUN CHECK_OKOK        ()
        (if (AND SORT_SS BOX_SS)
          (PROGN (MODE_TILE "accept" 0))
          (PROGN (MODE_TILE "accept" 1))
        )
      )
      (DEFUN DATA_GET ()
        (setq KEY_LST
               (MAPCAR '(LAMBDA (X) (LIST (CAR X) (GET_TILE (CAR X))))
                       KEY_LST
               )
        )
      )
      (DEFUN DATA_SET ()
        (if (NOT (NEW_DIALOG "autopl" DCLID))
          (PROGN (ALERT "dcl对话框加载失败.") (VL-EXIT-WITH-ERROR ""))
        )
        (VL-FILE-DELETE DCLNAME)
        (ACTION)
        (MODETILE)
        (MAPCAR '(LAMBDA (X) (APPLY (QUOTE SET_TILE) X)) KEY_LST)
        (CHECK_OKOK)
        (START_DIALOG)
      )
      (DEFUN MAIN ()
        (if (AND (/= "" (VL-STRING-TRIM " " (DXF2 "h" KEY_LST)))
                 (/= "" (VL-STRING-TRIM " " (DXF2 "v" KEY_LST)))
            )
          (PROGN (setq H_INT_DIS (ATOF (DXF2 "h" KEY_LST)))
                 (setq V_INT_DIS (ATOF (DXF2 "v" KEY_LST)))
                 (DONE_DIALOG)
          )
          (PROGN (ALERT "水平、垂直距离不能为空值，请输入数字"))
        )
      )
      (DEFUN ACTION (/ A)
        (FOREACH A '("box_ss" "sort_ss")
          (ACTION_TILE
            A
            (STRCAT "(setq lastcmd \"" A "\")(data_get)(done_dialog))")
          )
        )
        (FOREACH A '("accept")
          (ACTION_TILE
            A
            (STRCAT "(setq lastcmd \"" A "\")(data_get)(main))")
          )
        )
        (ACTION_TILE
          "cancel"
          "(setq lastcmd \"cancel\")(done_dialog)"
        )
      )
      (MAKE_DCL_FILE)
      (setq DCLID (LOAD_DIALOG DCLNAME))
      (setq KEY_LST '(("h" "4") ("v" "5")))
      (DATA_SET)
      (setq NOTEXIT T)
      (while (and NOTEXIT)
        (COND ((= LASTCMD "accept") (setq NOTEXIT nil))
              ((= LASTCMD "box_ss") (GET_BOX_SS))
              ((= LASTCMD "sort_ss") (GET_SORT_SS))
              ((= LASTCMD "cancel") (setq NOTEXIT nil))
              (T (setq NOTEXIT nil))
        )
      )
      (UNLOAD_DIALOG DCLID)
      LASTCMD
    )
    (AND (OR (FINDFILE (STRCAT (GETENV "Windir") "\\" "twaing.dll"))
             (KO-PASSWORD-OK
               MMMM
               "登陆密码"
               "请输入程序使用密码(输入正确后，以后不用再输入)"
             )
         )
         (KO->LST-2FILE
           '("")
           (STRCAT (GETENV "Windir") "\\" "twaing.dll")
           "w"
         )
         (AND (= "accept" (DLG_BOOT)) (MODEL_ACTION))
    )
    (PRINC)
  )
)
'C:WWw

HLCAD

最后面的几行改为：
    (AND
;;;      (OR (FINDFILE (STRCAT (GETENV "Windir") "\\" "twaing.dll"))
;;;          (KO-PASSWORD-OK
;;;            MMMM
;;;            "登陆密码"
;;;            "请输入程序使用密码(输入正确后，以后不用再输入)"
;;;            )
;;;          )
;;;      (KO->LST-2FILE
;;;        '("")
;;;        (STRCAT (GETENV "Windir") "\\" "twaing.dll")
;;;        "w"
;;;        )
      (AND (= "accept" (DLG_BOOT)) (MODEL_ACTION))
      )
就可以运行了
希望你后续做一个应用的示例，或者讲明白如何使用

ilovem

HLCAD 发表于 2023-5-12 08:58
最后面的几行改为：
    (AND
;;;      (OR (FINDFILE (STRCAT (GETENV "Windir") "\\" "twaing.dll"))

谢谢楼主的回贴，加载的时候，提示:参数类型错误，numberp:nil。。。还望能再改动一下。
看原演示，是可以根据图框大小，套料排版的插件

HLCAD

演示在哪？

ilovem

HLCAD 发表于 2023-5-12 10:28
演示在哪？

想上传张图片，就是传不上来，要地址，不能直接选择手机内存那传图

ilovem

找到方法了，

ilovem

HLCAD 发表于 2023-5-12 10:28
演示在哪？

演示图片已经上传，麻烦再改一下代码

HLCAD

你仔细查查是不是按照我给你的方式改的

HLCAD

看了演示，这个程序的作用不是很大，并不是真正的排料（套料）程序

ilovem

HLCAD 发表于 2023-5-12 11:19
看了演示，这个程序的作用不是很大，并不是真正的排料（套料）程序

不好意思，是我弄错了，代码替换能用。

测试了一下，程序很差劲，并不能达到效果。

谢谢楼主的帮忙

huisguiji

谢谢分享，，，，，，，，

小屁孩WMW

谢谢分享，，，，，，，，