如果一个字符串,预估它所占的宽度
整体预估函数,这样即可,整体预估会不准确,
- ;;166 [功能] 预测字符长度 by st788796
- (defun XD::Stringen (sty str h scl)
- (and (or (not sty)
- (= sty "")
- (not (tblsearch "style" sty))
- )
- (setq sty (getvar "textstyle"))
- )
- (abs
- (car
- (apply
- 'mapcar
- (cons
- '-
- (textbox
- (list (cons 1 str) (cons 7 sty) (cons 40 h) (cons 41 scl))
- )
- )
- )
- )
- )
- )
准确点应该智能拆分,逐个预估求和,
以下基本都是是本坛的函数,整理下子,
- ;将字符串拆分成单字符列表-------(一级)------
- (defun sl_text:stringexplode (str / defined strdefined rtnstr pos)
- (setq defined
- (list
- "%%130" "%%131" "%%132" "%%133" "%%134" ;1~4级钢筋符号+特殊钢筋
- "%%135" "%%136" "%%137" "%%138" ;L型钢+H型钢+槽型钢+工字钢
- "%%150" "%%151" "%%152" "%%153" "%%154" "%%155" "%%156" "%%157" "%%158" "%%159" ;罗马数字
- "%%177" "%%p" "%%P" ;正负号
- "%%c" "%%C" "%%D" "%%d" "%%%";直径符号+度数符号+%
- '("%%140" "%%141") '("%%142" "%%143") ;上下标开关
- '("%%200" "%%201") '("%%202" "%%203") '("%%204" "%%205") ;圆圈数字
- )
- )
- (while (> (strlen str) 0)
- (cond
- ((setq strdefined
- (vl-some
- '(lambda (sub / strdefined) (setq strdefined (if (listp sub) (car sub) sub)) (if (eq (substr str 1 (strlen strdefined)) strdefined) sub))
- defined
- )
- )
- (if (listp strdefined)
- (if (setq pos (vl-string-search (cadr strdefined) str))
- (setq rtnstr (cons (substr str 1 (+ pos (strlen (cadr strdefined)))) rtnstr) str (substr str (+ 1 pos (strlen (cadr strdefined)))))
- (setq rtnstr (cons str rtnstr) str "")
- )
- (setq rtnstr (cons strdefined rtnstr) str (substr str (1+ (strlen strdefined))))
- )
- )
- ((> (ascii (substr str 1 1)) 128) ;大于128为汉字
- (if (and (>= (atoi (substr (ver) 13)) 2021) (/= (getvar "lispsys") 0))
- (setq rtnstr (cons (substr str 1 1) rtnstr) str (substr str 2))
- (setq rtnstr (cons (substr str 1 2) rtnstr) str (substr str 3))
- )
- )
- (t
- (setq rtnstr (cons (substr str 1 1) rtnstr) str (substr str 2))
- )
- )
- )
- (reverse rtnstr)
- )
- ;取字符-文字(宽度)----(一级)---
- ;;str;需要检测的字符串,如果为nil则取 ent(nil)文字内码表
- (defun sl_text:gettextwidth (str ent / box1 bo2)
- (if (not str) (setq str (dxf1 ent 1)))
- (setq box1 (textbox (sl:list-substassoc (list (cons 1 (strcat "m" str "m"))) ent T)))
- (setq box2 (textbox (sl:list-substassoc (list (cons 1 "mm")) ent T)))
- (- (- (caadr box1) (caar box1))
- (- (caadr box2) (caar box2))
- )
- )
- ;;预测字符所占宽度-----(一级)-----
- ;;str 字符 "千万不要忘记阶级斗争"
- ;;hi 字高 3.0 sty 文字样式 scl 文字宽高比
- ;;SLdesign V3.0 Mofify-Arrange By 尘缘一生 QQ:15290049
- (defun text:slstringlen (str hi sty scl / strlis ent wid)
- (setq strlis (sl_text:stringexplode str) wid 0)
- (setq ent
- (list
- (cons 40 hi)
- (cons 41 scl)
- (cons 7 sty)
- )
- )
- (while (setq str0 (car strlis))
- (setq wid (+ (sl_text:gettextwidth str0 ent) wid))
- (setq strlis (cdr strlis))
- )
- wid
- )
- ;;测试---
- (defun c:tt (/ len)
- (setq len (text:slstringlen "千万不要忘记阶级斗争" 3.0 "standard" 0.7))
- len ;27.7812
- )
|