[分享]：获得TEXT中每个字符的位置

wkai

[php]
;;;200409261213___________________________
;;;字符串转换为表_________________________
(defun text_to_lst (text / n char strlst)
  (setq n 1)
  (while (<= n (strlen text))
    (setq char (substr text n 1))
    (if    (> (ascii char) 159)
      (and (substr text (1+ n) 1)
       (setq strlst (cons (substr text n 2) strlst))
       (setq n (1+ n))
      )
      (setq strlst (cons char strlst))
    )
    (setq n (1+ n))
  )
  (reverse strlst)
)
;;;测量TEXT中的每个字的宽度___________________
(defun c:tt (/ el str ang p lst pts pp  n p0)
  (princ "\nWRITEN BY WKAI @ XDCAD.NET")
  (setq el (entget (car (entsel))))
  (mapcar '(lambda (x y) (set x (cdr (assoc y el))))
      '(str ang p)
      '(1 50 10)
  )
  (setq lst (text_to_lst str))
  (while lst
    (setq
      pts (append
        pts
        (list
          (cadr
        (textbox
          (subst (cons 1 (apply 'strcat lst)) (assoc 1 el) el)
        )
          )
        )
      )
    )
    (setq lst (reverse (cdr (reverse lst))))
  )
  (setq pts (mapcar 'car pts))
  (setq pts (reverse pts))
  (setq p0 (polar p ang (caar (textbox el))))
  (setq pp (mapcar '(lambda (x) (polar p0 ang x)) pts))
  (foreach n (cons p pp) (command "._point" "non" n))
)
[/php]

                               
登录/注册后可看大图

wkai

上段代码求出的是字符的结束点
这个是字符的开始点
[PHP]
;;;200409281432___________________________
;;;字符串转换为表_________________________
(defun text_to_lst (text / n char strlst)
  (setq n 1)
  (while (<= n (strlen text))
    (setq char (substr text n 1))
    (if        (> (ascii char) 159)
      (and (substr text (1+ n) 1)
           (setq strlst (cons (substr text n 2) strlst))
           (setq n (1+ n))
      )
      (setq strlst (cons char strlst))
    )
    (setq n (1+ n))
  )
  strlst
)
;;;测量TEXT中的每个字的宽度___________________
(defun c:tt (/ el str ang p lst pts pp n p0 string len)
  (princ "\nWRITEN BY WKAI @ XDCAD.NET")
  (setq        el     (entget (car (entsel)))
        string ""
  )
  (mapcar '(lambda (x y) (set x (cdr (assoc y el))))
          '(str ang p)
          '(1 50 10)
  )
  (setq len (caadr (textbox el)))
  (setq p0 (polar p ang (caar (textbox el))))
  (setq lst (text_to_lst str))
  (foreach n lst
    (setq string (strcat n string))
    (setq pts (append pts(list(caadr(textbox(subst (cons 1 string)(assoc 1 el) el))))))
    )
  (setq pts (reverse (mapcar '(lambda (x) (- len x)) pts)))
  (setq pp (mapcar '(lambda (x) (polar p0 ang x)) pts))
  (foreach n (cons p pp) (command "._point" "non" n))
)

[/PHP]

                               
登录/注册后可看大图

shisj

虽然我没有看懂，这一直是我的疑惑之一，谢谢了，我收藏了

lsjjm

1. 字符串转换为表: (mapcar 'chr (vl-string->list str)) 更简单.
2. 有些字符如 "f" 可能误差.

wkai

(mapcar 'chr (vl-string->list str)) 只能处理英文。

lsjjm

最初由 wkai 发布
[B](mapcar 'chr (vl-string->list str)) 只能处理英文。 [/B]

第2 呢?--  2 . 有些字符如 "f" 可能误差.

wkai

怎么能确定上图中 f 的插入点位置有误差呢？

lsjjm

最初由 wkai 发布
[B]怎么能确定上图中 f 的插入点位置有误差呢？ [/B]

用你的程序返回的点插入原来字串的各个字符, 有的字符与原来不重合.

wkai

确切的说返回的是该字符textbox的左下角点，和它插入点有微差。
下面代码修正了TTF字体中空格没有返回点的问题。

2. 
   
3. ;;;200409031700___________________________
   
4. ;;;字符串转换为表_________________________
   
5. (defun text_to_lst (text / n char strlst)
   
6.   (setq n 1)
   
7.   (while (<= n (strlen text))
   
8.     (setq char (substr text n 1))
   
9.     (if        (> (ascii char) 159)
   
10.       (and (substr text (1+ n) 1)
    
11.            (setq strlst (cons (substr text n 2) strlst))
    
12.            (setq n (1+ n))
    
13.       )
    
14.       (setq strlst (cons char strlst))
    
15.     )
    
16.     (setq n (1+ n))
    
17.   )
    
18.   (reverse strlst)
    
19. )
    
20. ;;;测量TEXT中的每个字的宽度___________________
    
21. (defun c:tt (/ el str ang p lst pts pp n p0 string len)
    
22.   (princ "\nWRITEN BY WKAI @ XDCAD.NET")
    
23.   (setq    el     (entget (car (entsel)))
    
24.     string ""
    
25.   )
    
26.   (mapcar '(lambda (x y) (set x (cdr (assoc y el))))
    
27.       '(str ang p)
    
28.       '(1 50 10)
    
29.   )
    
30.   (setq len (caadr (textbox el)))
    
31.   (setq p0 (polar p ang (caar (textbox el))))
    
32.   (setq lst (reverse(text_to_lst str)) )
    
33.   (foreach n lst
    
34.     (if (= " " n)(setq n "t"))
    
35.     (setq string (strcat n string))
    
36.     (setq pts (append pts(list(caadr(textbox(subst (cons 1 string)(assoc 1 el) el))))))
    
37.     )
    
38.   (setq pts (reverse (mapcar '(lambda (x) (- len x)) pts)))
    
39.   (setq pp (mapcar '(lambda (x) (polar p0 ang x)) pts))
    
40.   (foreach n (cons p pp) (command "._point" "non" n))
    
41. )
    

<br /> ;;;200409031700___________________________ <br /> ;;;字符串转换为表_________________________ <br /> (defun text_to_lst (text / n char strlst)<br />   (setq n 1)<br />   (while (<= n (strlen text))<br />     (setq char (substr text n 1))<br />     (if        (> (ascii char) 159)<br />       (and (substr text (1+ n) 1)<br />            (setq strlst (cons (substr text n 2) strlst))<br />            (setq n (1+ n))<br />       )<br />       (setq strlst (cons char strlst))<br />     )<br />     (setq n (1+ n))<br />   )<br />   (reverse strlst)<br /> )<br /> ;;;测量TEXT中的每个字的宽度___________________ <br /> (defun c:tt (/ el str ang p lst pts pp n p0 string len) <br />   (princ "\nWRITEN BY WKAI @ XDCAD.NET") <br />   (setq    el     (entget (car (entsel))) <br />     string "" <br />   ) <br />   (mapcar '(lambda (x y) (set x (cdr (assoc y el)))) <br />       '(str ang p) <br />       '(1 50 10) <br />   ) <br />   (setq len (caadr (textbox el))) <br />   (setq p0 (polar p ang (caar (textbox el)))) <br />   (setq lst (reverse(text_to_lst str)) )<br />   (foreach n lst<br />     (if (= " " n)(setq n "t"))<br />     (setq string (strcat n string)) <br />     (setq pts (append pts(list(caadr(textbox(subst (cons 1 string)(assoc 1 el) el)))))) <br />     ) <br />   (setq pts (reverse (mapcar '(lambda (x) (- len x)) pts))) <br />   (setq pp (mapcar '(lambda (x) (polar p0 ang x)) pts)) <br />   (foreach n (cons p pp) (command "._point" "non" n)) <br /> )<br />