求修改里面的求和程序。

lxdz443 发表于 2015-4-5 09:04:07

现在的程序有以下的问题需要修改：
1.前缀是汉字的无法求和。
2.前缀是字母或数字的，只能显示一个。
3.字体大小默认为1，字体大小改为2后，表格不会跟随字体大小变化。
源程序如下：
;主要对单行文本多行文本全是数字或前后有中文，字母等的数字求合
(defun c:HK ()
(SETQ OM (GETVAR "CMDECHO"))
(SETVAR "CMDECHO" 0)
(setq ss (ssget '((0 . "*TEXT")))
n 0
XY (GETPOINT "请点击表格左上角位置:")
)
(setq sl (sslength ss))
(SETQ zmlist '()
zwlist '()
szlist '()
zmlist1 '()
ZWLIST1'()
)
(repeat sl
(setq a (cdr (assoc 1 (entget (ssname ss n)))))
(setq a1 (vl-string->list a))
(setq max1 (apply 'max a1))
(setq sz1 (<= max1 57)
      ZM1 (AND (<= max1 122) (> MAX1 57))
      ZW1 (>= MAX1 128)
   )
(IF (AND (= SZ1 T) (= ZM1 NIL) (= ZW1 NIL))
   (progn
   (setq sz2 (atoi a))
   (setq szlist (cons sZ2 szlist))
   )
   )
(IF (AND (= SZ1 NIL) (= ZM1 T) (= ZW1 NIL))
   (PROGN
(setq zm2 (vl-position max1 a1))
(if (= zm2 0)
         (progn
   (setq zm3 (atoi (substr a 2)))
   (setq zmlist (cons zm3 zmlist))
   )
      (progn
   (setq zm3 (atoi (substr a 1 (- (strlen a) 1))))
   (setq zmlist1 (cons zm3 zmlist1))
   )
   )
   (setq zm4 (substr a (+ zm2 1) 1))
)
   )
(IF (AND (= SZ1 NIL) (= ZM1 NIL) (= ZW1 T))
   (PROGN
   (setq ZW2 (VL-POSITION MAX1 A1))
   (IF (= ZW2 0)
(PROGN
   (SETQ ZW3 (ATOI (SUBSTR A 3)))
   (SETQ ZWLIST (CONS ZW3 ZWLIST))
   )
(PROGN
   (SETQ ZW2 (ATOI (SUBSTR A 1 (- (STRLEN A) 2))))
   (SETQ ZWLIST1 (CONS ZW3 ZWLIST1))
   )
)
      (SETQ ZW4 (SUBSTR A (+ ZW2 1) 2))
   )
   )
(SETQ N (1+ N))
)
(IF (/= SZLIST NIL)
   (PROGN
   (SETQ SZH (APPLY '+ SZLIST))
   (SETQ SZLR (RTOS SZH 2 0))
   (SETQ HILGH (STRLEN SZLR))
   (SETQ XY1 (POLAR XY (ANGTOF "270") 1.5)
XY2 (POLAR XY 0 HILGH)
XY3 (POLAR XY1 0 HILGH)
XY4 (POLAR XY (ANGTOF "279") 1.5)
)
   (COMMAND "PLINE"XY1 XY3 XY2 XY "C" )
   (COMMAND "TEXT" "J" "BL" XY4 "1" "0" SZLR)
   (SETQ XY XY2)
   )
   )
(IF (/= ZMLIST NIL)
   (PROGN
(SETQ ZMH (APPLY '+ ZMLIST))
(SETQ ZMLR (STRCAT ZM4 (RTOS ZMH 2 0)))
(SETQ HILGH (STRLEN ZMLR))
(SETQ XY1 (POLAR XY (ANGTOF "270") 1.5)
XY2 (POLAR XY 0 HILGH)
XY3 (POLAR XY1 0 HILGH)
      XY4 (POLAR XY (ANGTOF "279") 1.5)
)
(COMMAND "PLINE" XY1 XY3 XY2 XY "C" )
(COMMAND "TEXT" "J" "BL" XY4 "1" "0" ZMLR )
   (SETQ XY XY2)
   )
   )
(IF (/= ZMLIST1 NIL)
   (PROGN
   (SETQ ZMH (APPLY '+ ZMLIST1))
(SETQ ZMLR (STRCAT ZM4 (RTOS ZMH 2 0)))
(SETQ HILGH (STRLEN ZMLR))
(SETQ XY1 (POLAR XY (ANGTOF "270") 1.5)
XY2 (POLAR XY 0 HILGH)
XY3 (POLAR XY1 0 HILGH)
XY4 (POLAR XY (ANGTOF "279") 1.5)
)
   (COMMAND "PLINE" XY1 XY3 XY2 XY "C" )
   (COMMAND "TEXT" "J" "BL" XY4 "1" "0" ZMLR)
   (SETQ XY XY2)
   )
   )
(IF (/= ZWLIST NIL)
   (PROGN
   (SETQ ZMH (APPLY '+ ZWLIST))
(SETQ ZMLR (STRCAT ZW4 (RTOS ZMH 2 0)))
(SETQ HILGH (STRLEN ZMLR))
(SETQ XY1 (POLAR XY (ANGTOF "270") 1.5)
XY2 (POLAR XY 0 HILGH)
XY3 (POLAR XY1 0 HILGH)
XY4 (POLAR XY (ANGTOF "279") 1.5)
)
   (COMMAND "PLINE" XY1 XY3 XY2 XY "C" )
   (COMMAND "TEXT" "J" "BL" XY4 "1" "0" ZMLR)
   (SETQ XY XY2)
   )
   )
(IF (/= ZWLIST1 NIL)
   (PROGN
   (SETQ ZMH (APPLY '+ ZWLIST))
(SETQ ZMLR (STRCAT ZW4 (RTOS ZMH 2 0)))
(SETQ HILGH (STRLEN ZMLR))
(SETQ XY1 (POLAR XY (ANGTOF "270") 1.5)
XY2 (POLAR XY 0 HILGH)
XY3 (POLAR XY1 0 HILGH)
XY4 (POLAR XY (ANGTOF "279") 1.5)
)
   (COMMAND "PLINE" XY1 XY3 XY2 XY "C" )
   (COMMAND "TEXT" "J" "BL" XY4 "1" "0" ZMLR )
   (SETQ XY XY2)
   )
   )
(SETVAR "CMDECHO" OM)
(princ)
)
(princ "程序加载成功输入HK运行!")

chenbh2 发表于 2015-4-5 22:22:49

期待高手出现!

xyp1964 发表于 2015-4-6 12:11:07

xchj81 发表于 2015-4-6 12:48:54

kankan谢谢

chenbh2 发表于 2015-4-6 14:21:47

xyp1964 发表于 2015-4-6 12:11 static/image/common/back.gif

下载了,楼主的e派工具箱无所不能呀!

lxdz443 发表于 2015-4-7 05:52:43

院长，你这是在眼馋我们啊，没有你的工具箱，我们只能看，不能用啊。

lxdz443 发表于 2015-4-7 19:02:36

我这边下载链接提示失效了，打不开。

页: [1]

明经CAD社区's Archiver

求修改里面的求和程序。