;;;加载对 C:CAL 函数的支持
(if (or (= (type c:cal) 'list)  ;R14使用
 (= (type c:cal) 'SUBR)  ;R2000+使用
 (= (type c:cal) NIL)  ;R2004使用
    )
    (arxload "geomcal.arx")
)

(vl-load-com)
;;;==================================================================
;;;功能：text文本表示的数字计算
(defun C:.. (/ *LST_01 *STR *LST *NNN_MIN *NNN_LST *N *SS *I *ENT Z
      *ENT_LST *NUM)
    ;;分隔符 和 运算符
    (setq *LST_01 '((" ") ("(") (")") ("+") ("-") ("*") ("/") ("^")))
    ;;获取计算公式
    (princ
 (strcat
     "\n>>>小提示: A、B...打头表示一列文本；"
     "\n           I、J...打头表示单个文本；"
     "\n           Z表示结果对象本身；"
 )
    )
    (if (and (setq *STR (getstring t "\n请输入公式: "))
      (setq *LST (ZL-STR-SUB2 *STR *LST_01))
 )
 (progn
     ;;初始化
     (setq *NNN_MIN 1000000000) ;_记录最小的一组对象个数
     (setq *NNN_LST '()) ;_存放选择对象的表
     ;;提示用户，选取对象
     (foreach *N *LST
  (cond
      ;;判断是否是分隔符 和 运算符
      ((assoc *N *LST_01)
       () ;_不做处理，跳过
      )
      ;;判断是否以 Z，表示结果对象本身
      ((= (ascii (strcase *N)) 90)
   () ;_不做处理，跳过
      )
      ;;判断是否是lisp函数
      ((= (type (read *n)) 'SUBR);_这句不妥
   ()
      )
      ;;判断是否以 A、B...打头
      ((<= 65 (ascii (strcase *N)) 72)
       (if (assoc *N *NNN_LST)
    ()
    (progn
        (princ (strcat "\n>>>选取 " *N " 对象..."))
        (if (setq *SS (ssget '((0 . "TEXT"))))
     (progn
         (setq *NNN_MIN
           (min (sslength *SS) *NNN_MIN)
         )
         ;;构建表，并排序
         (setq *ENT_LST (SS->LST *SS))
         ;;
         (setq
      *NNN_LST
         (cons
      (cons *N *ENT_LST)
      *NNN_LST
         )
         )
     )
     ()
        )
    )
       )
      )
      ;;判断是否以 I、J...打头
      ((<= 73 (ascii (strcase *N)) 89)
       (if (setq *SS (entsel (strcat "\n点取选择 " *N)))
    (set (read *N)
         (read (cdr (assoc 1 (entget (car *SS))))
         )
    )
    (set (read *N) 0.0)
       )
       (princ "  ")
       (princ (eval (read *N)))
      )
      ;;如果有其他符号存在，则提示一下
      (t
       (princ "\n存在约定外符号: ")
       (princ *N)
      )
  )
     )
     ;;计算
     (princ "\n>>>>>>>>>>>>>>>>>>>>>>")
     (princ "\n>>>选择结果存放位置... ")
     (if (setq *SS (ssget '((0 . "TEXT"))))
  (progn
      (setq *NNN_MIN
        (min (sslength *SS) *NNN_MIN)
      )
      ;;构建表，并排序
      (setq *ENT_LST (SS->LST *SS))
      (setq *I 0)
      (repeat *NNN_MIN
   ;;本身对象赋值
   (setq *ENT (nth *I *ENT_LST)
         Z    (read (cdr (assoc 1 *ENT))) ;_read 函数有待改进
   )
   ;;对一列选择的对象赋值
   (foreach *N *NNN_LST
       (set (read (car *N))
     (read (cdr (assoc 1 (nth (1+ *I) *N))))
       )
   )
   ;;计算
   (if (or (setq *NUM (eval (read *STR)))
    (setq *NUM (c:cal *STR))
       )
       (progn
    ;;(princ NUM)
    (setq
        *ENT
           (subst (cons 1 (rtos *NUM 2 2))
           (assoc 1 *ENT)
           *ENT
           )
    )
    (entmod *ENT)
       )
   )
   (setq *I (1+ *I))
      )
  )
     )
     ;;
     ()
 )
    )
    (princ)
)
;;;==================================================================

;;;====================================================
;;;      函数二                                       
;;;功能：字符串按照符进行分割                         
;;;参数：STR ----欲分割的字符串，支持汉字             
;;;      LST ----分隔符表，大小写敏感                 
;;;日期：zml84 于 2008-02-19                          
;;;示例：(ZL-STR-SUB2 "1N3.5(2)" '(("N")("(" ")")))   
;;;       ===>>  ("1" "N" "3.5" "(2)")                
;;;示例：(ZL-STR-SUB2 "abc汉字2(1.5)" '(("汉""字")))  
;;;       ===>>  ("abc" "汉字" "2(1.5)")              
(defun ZL-STR-SUB2 (STR LST / I LST2 LST_TMP STRI STR_TMP)
    (setq LST2 '()) ;_存放结果的变量
    (setq STR_TMP "")
    (while (/= STR "")
 (if (> (ascii (substr STR 1 1)) 159)
     (setq STRI (substr STR 1 2)
    STR  (substr STR 3)
     )
     (setq STRI (substr STR 1 1)
    STR  (substr STR 2)
     )
 )
 (if (setq LST_TMP (assoc STRI LST))
     (progn
  (if (/= STR_TMP "")
      (setq LST2   (cons STR_TMP LST2)
     STR_TMP ""
      )
  )
  (cond
      ((= 1 (length LST_TMP))
       (setq LST2 (cons STRI LST2))
      )
      ((= 2 (length LST_TMP))
       (if (setq I (vl-string-search (cadr LST_TMP) STR))
    (setq LST2 (cons
     (strcat STRI
      (substr STR 1 I)
      (cadr LST_TMP)
     )
     LST2
        )
          STR  (substr STR
         (+ 1 I (strlen (cadr LST_TMP)))
        )
    )
    (setq LST2 (cons STR LST2)
          STR  ""
    )
       )
      )
  )
     )
     (setq STR_TMP (strcat STR_TMP STRI))
 )
    )
    (if (/= STR_TMP "")
 (setq LST2 (cons STR_TMP LST2))
    )
    (reverse LST2)
) ;_结束defun
;;;==================================
;;;功能：选择集转换到组码表，并排序
(defun SS->LST (SS / LST I)
    (setq LST '()
   I   0
    )
    (repeat (sslength SS)
 (setq LST (cons (entget (ssname SS I)) LST))
 (setq I (1+ I))
    )
    ;;排序
    (setq LST (vl-sort LST
         (function
      (lambda (*E1 *E2)
          ;;按照x坐标排序
          ;;(< (car (cdr (assoc 10 *e1))) (car (cdr (assoc 10 *e2))))
          ;;按照Y坐标排序
          (< (cadr (cdr (assoc 10
          *E1
          )
     )
      )
      (cadr (cdr (assoc 10
          *E2
          )
     )
      )
          )
      )
         )
       )
    )
    ;;返回
    LST
)
;;;==================================