绘制文字矢量

lijiao · 发表于 2016-5-17 11:48:20

;;;函数名称：cs-GrText
;;;函数功能：显示文字矢量
;;;调用方法：(cs-GrText lst)
;;;参数说明：lst为nil时,如(cs-GrText ?),显示使用方法
;;; lst为表时，如(cs-GrText (list point str1 str2 str3 ...))
(defun cs-GrText (lst / A ASC OSTR PT SCL STR VEC XCO YCO)
(defun cs-get-txt (filename / FILE OUT TEMP)
(if (setq filename (findfile filename))
(progn
(setq out '())
(setq file (open filename "r"))
(while (setq temp (read-line file))
(setq out (cons temp out))
)
(close file)
(setq out (reverse out))
)
)
)
(or *cszk*
(and (princ "\n正在初始化字库")
(setq *cszk* (mapcar 'read (CS-GET-TXT "hztxt.txt")))
(princ "\r初始化字库成功\n")
)
)
(if lst
(progn
(setq pt (car lst)
str (apply 'strcat (cons (cadr lst) (mapcar '(lambda (x) (strcat "\n" x)) (cddr lst))))
)
(setq scl (/ (getvar 'viewsize) (cadr (getvar 'screensize)))
scl (* 0.12 scl)
pt (trans pt 1 2)
)
(if (/= str (car *cs_strvec*))
(progn
(setq xco 0
yco 0
ostr str)
(while (> (strlen str) 0)
(cond
((member (substr str 1 3) '("%%d" "%%D"))
(setq asc "%%d"
str (substr str 4))
)
((member (substr str 1 3) '("%%c" "%%C"))
(setq asc "%%c"
str (substr str 4))
)
((member (substr str 1 3) '("%%p" "%%P"))
(setq asc "%%p"
str (substr str 4))
)
((> (ascii (substr str 1 1)) 126)
(setq asc (substr str 1 2)
str (substr str 3)
)
)
(t
(setq asc (substr str 1 1)
str (substr str 2)
)
)
)
(cond
((= " " asc)
(setq xco (+ xco 127.0))
)
((= "\t" asc)
(setq xco (+ xco 16000.0))
)
((= "\n" asc)
(setq xco 0
yco (- yco 180.0)
)
)
((setq vec
(cons
(mapcar
'(lambda (a)
(list (+ (car a) xco) (+ (cadr a) yco))
)
(cdr (assoc asc *cszk*))
)
vec
)
)
(setq xco (+ xco 127.0))
)
)
)
(setq vec (apply 'append vec))
(setq *cs_strvec* (append (list ostr 2) vec))
)
)
(grvecs (cdr *cs_strvec*)
(list
(list scl 0.0 0.0 (+ (car pt) (* 50.0 scl)))
(list 0.0 scl 0.0 (+ (cadr pt) (* -200.0 scl)))
(list 0.0 0.0 scl 0.0)
'(0.0 0.0 0.0 1.0)
)
)
)
(xslist '("(cs-grtext (list pt str))"
"pt 参考点"
"str 文本")
)
)
(princ)
)

;;;函数名称：cs-GrText 
;;;函数功能：显示文字矢量 
;;;调用方法：(cs-GrText lst) 
;;;参数说明：lst为nil时,如(cs-GrText ?),显示使用方法 
;;;          lst为表时，如(cs-GrText (list point str1 str2 str3 ...)) 
 
 
(defun cs-GrText  (lst / A ASC OSTR PT SCL STR VEC XCO YCO) 
  (defun cs-get-txt  (filename / FILE OUT TEMP) 
    (if (setq filename (findfile filename)) 
      (progn 
        (setq out '()) 
        (setq file (open filename "r")) 
        (while (setq temp (read-line file)) 
          (setq out (cons temp out)) 
          ) 
        (close file) 
        (setq out (reverse out)) 
        ) 
      ) 
    ) 
  (or *cszk* 
      (and (princ "\n正在初始化字库") 
           (setq *cszk* (mapcar 'read (CS-GET-TXT "hztxt.txt"))) 
           (princ "\r初始化字库成功\n") 
           ) 
      ) 
  (if lst 
    (progn 
      (setq pt  (car lst) 
            str (apply 'strcat (cons (cadr lst) (mapcar '(lambda (x) (strcat "\n" x)) (cddr lst)))) 
            ) 
      (setq scl (/ (getvar 'viewsize) (cadr (getvar 'screensize))) 
            scl (* 0.12 scl) 
            pt  (trans pt 1 2) 
            ) 
      (if (/= str (car *cs_strvec*)) 
        (progn 
          (setq xco  0 
                yco  0 
                ostr str) 
          (while (> (strlen str) 0) 
            (cond 
              ((member (substr str 1 3) '("%%d" "%%D")) 
               (setq asc "%%d" 
                     str (substr str 4)) 
               ) 
              ((member (substr str 1 3) '("%%c" "%%C")) 
               (setq asc "%%c" 
                     str (substr str 4)) 
               ) 
              ((member (substr str 1 3) '("%%p" "%%P")) 
               (setq asc "%%p" 
                     str (substr str 4)) 
               ) 
              ((> (ascii (substr str 1 1)) 126) 
               (setq asc (substr str 1 2) 
                     str (substr str 3) 
                     ) 
               ) 
              (t 
               (setq asc (substr str 1 1) 
                     str (substr str 2) 
                     ) 
               ) 
              ) 
            (cond 
              ((= " " asc) 
               (setq xco (+ xco 127.0)) 
               ) 
              ((= "\t" asc) 
               (setq xco (+ xco 16000.0)) 
               ) 
              ((= "\n" asc) 
               (setq xco 0 
                     yco (- yco 180.0) 
                     ) 
               ) 
              ((setq vec 
                      (cons 
                        (mapcar 
                          '(lambda (a) 
                             (list (+ (car a) xco) (+ (cadr a) yco)) 
                             ) 
                          (cdr (assoc asc *cszk*)) 
                          ) 
                        vec 
                        ) 
                     ) 
               (setq xco (+ xco 127.0)) 
               ) 
              ) 
            ) 
          (setq vec (apply 'append vec)) 
          (setq *cs_strvec* (append (list ostr 2) vec)) 
          ) 
        ) 
      (grvecs (cdr *cs_strvec*) 
              (list 
                (list scl 0.0 0.0 (+ (car pt) (* 50.0 scl))) 
                (list 0.0 scl 0.0 (+ (cadr pt) (* -200.0 scl))) 
                (list 0.0 0.0 scl 0.0) 
                '(0.0 0.0 0.0 1.0) 
                ) 
              ) 
      ) 
    (xslist '("(cs-grtext (list pt str))" 
              "pt 参考点" 
              "str   文本") 
            ) 
    ) 
  (princ) 
  )

;;;以下为示例程序
(defun c:cstest (/ pt)
(while (member (car (setq pt (grread t 4 2))) '(2 25 5))
(if (= 5 (car pt))
(progn
(redraw)
(cs-grtext (list (cadr pt) "测试信息提示" "选择实体" "点击鼠标左键退出"))
)
)
)
(redraw)
(princ)
)

说明，字库文件须放在acad的搜索路径中

hn10183051 · 发表于 2023-8-6 15:47:56

ynhh 发表于 2020-12-25 11:46
原来是在屏幕上显示文字
不知能不能有空画图应用提示之类的实例？
谢谢

测试成功，对啊，不怎么画图的时候怎么运用~

yanshengjiang · 发表于 2021-12-14 00:06:51

大佬这个程序能不能和entsel 或者ssget结合呢，比如说我选择对象的时候就这样提示，而不是命令行提示选择对象

ynhh · 发表于 2020-12-25 11:46:12

原来是在屏幕上显示文字
不知能不能有空画图应用提示之类的实例？
谢谢

USER2128 · 发表于 2016-5-17 13:55:16

楼主：函数xslist没有定义

lijiao · 发表于 2016-5-17 17:40:16

USER2128 发表于 2016-5-17 13:55
楼主：函数xslist没有定义

(defun xslist (lst / )
(mapcar '(lambda(x)
(princ "\n")
(vl-princ1-to-string x)
)
lst)
(princ)
)

qyming · 发表于 2016-5-19 14:55:18

应用？？？？

ps122hb · 发表于 2016-5-23 08:47:10

本帖最后由 ps122hb 于 2016-5-23 12:13 编辑

好像没反应，单行多行都试了

ynhh · 发表于 2016-5-25 11:36:56

没看出来有什么反应啊

dabingrain · 发表于 2019-9-11 18:52:40

测试成功了，很好用，必须吧字库群文件放到搜索路径内才能显示

mokson · 发表于 2021-12-14 08:23:56

上个图看看就好了。

账号		自动登录	找回密码
密码			注册

[源码] 绘制文字矢量

本帖子中包含更多资源

点评

评分