(2008-03-08 10:21:36)   zml84(389280742)
;|;;
日期：2008-03-07晚
备忘:关于text对象中单个文字位置的计算

以下代码对于汉字字体类型的字母、汉字、数字组成的text对象，有效。
1：2
2：3
;;|;
;;;=========================================
;;;功能：获取TEXT对象中指定坐标位置的字符
;;;参数：EN ----text对象组码表
;;;      PT ----指定坐标位置（世界坐标系下）
;;;返回：若有，返回单个字符；若无，nil
;;;日期：zml84 于 2008-03-07
(defun TT (ENT PT / ANG II LST PT0 PTA PTB PT_ANG PT_DIST STR STRI WI)
    ;;插入点  角度  内容
    (setq PT0 (cdr (assoc 10 ENT))
      ANG (cdr (assoc 50 ENT))
      STR (cdr (assoc 1 ENT))
    )
    ;;局部坐标系两点
    (setq LST (textbox ENT))
    (setq PTA (car LST)
      PTB (cadr LST)
    )
    ;;///////////////////////////////////////
    ;;将pt由世界坐标系转化为TEXT局部坐标系
    ;;1.平移坐标系
    (setq PT (mapcar '- PT PT0))
    ;;2.旋转坐标系
    (setq PT_DIST (distance '(0 0 0) PT)
      PT_ANG  (angle '(0 0 0) PT)
      PT      (polar '(0 0 0) (- PT_ANG ANG) PT_DIST)
    )
    ;;///////////////////////////////////////
    ;;判断pt是否在文字包围盒中
    (if    (and (< (car PTA) (car PT) (car PTB))
         (< (cadr PTA) (cadr PT) (cadr PTB))
    )
    (progn
        ;;计算单个字符宽度
        (setq WI (/ (- (car PTB) (car PTA)) 1.0 (strlen STR)))
        (setq II (fix (/ (- (car PT) (car PTA)) WI)))
        ;;////////////////////////////////////////////////////
        ;;拆分字符串，构建查询用表
        ;;例如："汉12" 拆分为：("汉" "汉" "字" "字" "1" "2")
        (setq LST '()) ;_存放结果的变量
        (while (/= STR "")
        (if (> (ascii (substr STR 1 1)) 159)
            (setq STRI (substr STR 1 2)
              LST  (cons STRI LST)
              LST  (cons STRI LST)
              STR  (substr STR 3)
            )
            (setq STRI (substr STR 1 1)
              LST  (cons STRI LST)
              STR  (substr STR 2)
            )
        )
        )
        (setq LST (reverse LST))
        ;;////////////////////////////////////////////////////
        ;;查询得到结果
        (nth II LST)
    )
    NIL
    )
) ;_结束 dufun


;;;==================================
;;;功能：测试
(defun C:TT (/ SS ENT PT)
    (while (setq SS (entsel "\n请点取TEXT对象: "))
    (setq ENT (entget (car SS)))
    (if (= (cdr (assoc 0 ENT)) "TEXT")
        (while (setq PT (getpoint "\n指定点: "))
        (princ (TT ENT PT))
        )
    )
    )
    (princ)
)
;;;==================================
;;;功能：测试2
(defun C:TT2 (/ SS ENT PT)
    (while (setq SS (entsel "\n请点取TEXT对象中的文字: "))
    (setq ENT (entget (car SS))
          PT  (cadr SS)
    )
    (if (= (cdr (assoc 0 ENT)) "TEXT")
        (princ (TT ENT PT))
    )
    )
    (princ)
)