社区 › AutoLISP/Visual LISP 编程技术 › 绘制文字矢量

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 xco0
                yco0
                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 static/image/common/back.gif
楼主：函数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

上个图看看就好了。

查看完整版本: 绘制文字矢量