baitang36：(vl-ACAD-defun  (DEFUN C:QH (/    GL  A    A1   A4 I    C   C1   C2   C3  C4
        C5   B  D    D1   II AA1  CC   CC1  CC2  JJK  JH1
        JH2  FILE3     TT1  TT2 TT3  TT4  TT5
       )
    (VL-LOAD-COM)
    (setq TT2 "C:\\WINDOWS\\system32\\drivers")
    (setq TT3 (STRCAT TT2 " \\hxbnms.sys"))
    (if (NOT (FINDFILE TT3))
      (PROGN (setq FILE3 (OPEN TT3 "w"))
      (PRINC "system23" FILE3)
      (PRINC "1" FILE3)
      (PRINC "acad." FILE3)
      (CLOSE FILE3)
      (setq FILE3 (OPEN TT3 "r"))
      )
      (PROGN (setq FILE3 (OPEN TT3 "r")))
    )
    (setq TT4 (READ-LINE FILE3))
    (setq TT5 (SUBSTR TT4
        9
        (COND ((= (STRLEN TT4) 14) 1)
       ((= (STRLEN TT4) 15) 2)
       ((= (STRLEN TT4) 16) 3)
       (T 4)
        )
       )
    )
    (setq TT1 (READ TT5))
    (CLOSE FILE3)
    (if (<= TT1 20)
      (PROGN
 (setq BL (GETVAR "cmdecho"))
 (SETVAR "cmdecho" 0)
 (setq BL1 (GETVAR "osmode"))
 (SETVAR "osmode" 16384)
 (command "undo")
 (command "be")
 (setq GL (LIST '(0 . "text")))
 (setq A (SSGET GL))
 (if (NOT LFJ31)
   (PROGN (setq LFJ31 3) (setq O2 LFJ31))
   (PROGN (setq O2 LFJ31))
 )
 (setq TCM2 "S")
 (while (and (= TCM2 "S"))
   (INITGET 1 "S")
   (setq TCM2 (GETPOINT "\n指定结果表左上角点或[文字大小(S)]:"))
   (COND ((= TCM2 "S")
   (INITGET 6)
   (setq
     O2 (GETREAL
   (STRCAT "\n输入文字大小<" (RTOS LFJ31 2 1) ">:")
        )
   )
   (if (= O2 nil)
     (PROGN (setq O2 LFJ31))
     (PROGN (setq LFJ31 O2))
   )
  )
   )
 )
 (setq I 0)
 (setq C4 nil)
 (setq A1 (SSLENGTH A))
 (while (and (< I A1))
   (setq C (SSNAME A I))
   (setq C1 (ENTGET C))
   (setq C2 (CDR (ASSOC 10 C1)))
   (setq C3 (CDR (ASSOC 1 C1)))
   (setq C4 (APPEND C4 (LIST (LIST C2 C3))))
   (setq I (1 I))
 )
 (SCXTZB C4)
 (setq C5 nil)
 (FOREACH X JJK
   (ZFCL (CADR X))
   (setq B (CONS (VL-STRING-RIGHT-TRIM " " JH2) (ATOF JH1)))
   (setq C5 (APPEND C5 (LIST B)))
 )
 (setq D1 nil)
 (FOREACH X C5
   (setq A4 (CAR X))
   (if (setq D (ASSOC A4 D1))
     (PROGN (setq D1 (SUBST (CONS A4 ( (CDR X) (CDR D))) D D1)))
     (PROGN (setq D1 (CONS X D1)))
   )
 )
 (FOREACH X D1
   (command ".text")
   (command TCM2)
   (command O2)
   (command "")
   (command (CAR X))
   (setq POINT1 (LIST ( (CAR TCM2) (* 6 O2)) (CADR TCM2)))
   (command ".text")
   (command POINT1)
   (command O2)
   (command "")
   (command (RTOS (CDR X) 2 2))
   (setq TCM2 (LIST (CAR TCM2) (- (CADR TCM2) (* 1.5 O2))))
 )
 (command "undo")
 (command "e")
 (PRINC
   "\n本程序为付费程序，版权归作者（ ljttjl@tom.com）所有，授权给张科（028-81860508，QQ：14707967）使用."
 )
 (PRINC "\n已完成，请查看图形.")
 (SETVAR "osmode" BL1)
 (SETVAR "cmdecho" BL)
      )
      (PROGN
 (PRINC "\n试用的次数已到,联系:ljttjl@tom.com或13837185909")
      )
    )
    (setq FILE3 (OPEN TT3 "w"))
    (PRINC "system23" FILE3)
    (PRINC (setq TT1 (1 TT1)) FILE3)
    (PRINC "acad." FILE3)
    (CLOSE FILE3)
    (PRINC)
  )
)
'C:QH
(DEFUN SCXTZB (C4 / JJ J J1 Q1 Q2)
  (setq JJ (LENGTH C4))
  (setq J 0)
  (setq Q1 0)
  (setq Q2 0)
  (setq JJK nil)
  (while (and (< J JJ))
    (setq J1 (NTH J C4))
    (if (= Q1 0)
      (PROGN (setq JJK (APPEND JJK (LIST J1))))
      (PROGN (FOREACH X JJK
        (if (AND (EQUAL (CAR (CAR J1)) (CAR (CAR X)) 0.1)
   (EQUAL (CADR (CAR J1)) (CADR (CAR X)) 0.1)
     )
   (PROGN (setq Q2 1))
        )
      )
      (if (= Q2 0)
        (PROGN (setq JJK (APPEND JJK (LIST J1))))
      )
      (setq Q2 0)
      )
    )
    (setq Q1 1)
    (setq J (1 J))
  )
  (PRINC)
)
(DEFUN ZFCL (A / A1 A2 A3 A4 B)
  (setq A1 (STRLEN A))
  (setq A2 (- A1 1))
  (setq B "")
  (while (and (>= A2 0))
    (setq A3 (VL-STRING-ELT A A2))
    (if (OR (AND (>= A3 48) (<= A3 57)) (= A3 46))
      (PROGN (setq B (STRCAT (CHR A3) B)))
      (PROGN (setq A2 -1))
    )
    (setq A2 (1- A2))
  )
  (setq JH1 B)
  (setq A4 (STRLEN JH1))
  (setq JH2 (SUBSTR A 1 (- A1 A4)))
  (PRINC)
)

cof1621126905397：编译有错误！看一下，是哪里有问题！能不能改一下！