(XD::String:ActualWidth)获取构造文字长度

st788796 · 发表于 2013-10-15 14:57:06

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

;;sty -- textstyle

;;str -- string
;;h -- height
(defun XD::String:ActualWidth (str sty h scl / str1)
(if (= str "")
(setq str " ")
)
(setq str (vl-princ-to-string str))
(and
(or
(not sty)
(= sty "")
(not (tblsearch "style" sty))
)
(setq sty (getvar "textstyle"))
)
(if (setq str1 (xdrx_string_regexps "^[\\s]+$" str))
(progn
(- (abs (car (apply
'mapcar
(cons '- (textbox (list (cons 1 (strcat "a" str "a"))
(cons 7 sty) (cons 40 h)
(cons 41 scl)
)
)
)
)
)
) (abs (car (apply
'mapcar
(cons '- (textbox (list (cons 1 "aa") (cons 7 sty)
(cons 40 h) (cons 41 scl)
)
)
)
)
)
)
)
)
(progn
(abs (car (apply
'mapcar
(cons '- (textbox (list (cons 1 str) (cons 7 sty)
(cons 40 h) (cons 41 scl)
)
)
)
)
)
)
)
)
)

;;str -- string 
;;h   -- height 
(defun XD::String:ActualWidth (str sty h scl / str1) 
  (if (= str "") 
    (setq str " ") 
  ) 
  (setq str (vl-princ-to-string str)) 
  (and 
    (or 
      (not sty) 
      (= sty "") 
      (not (tblsearch "style" sty)) 
    ) 
    (setq sty (getvar "textstyle")) 
  ) 
  (if (setq str1 (xdrx_string_regexps "^[\\s]+$" str)) 
    (progn 
      (- (abs (car (apply 
                     'mapcar 
                     (cons '- (textbox (list (cons 1 (strcat "a" str "a")) 
                                             (cons 7 sty) (cons 40 h) 
                                             (cons 41 scl) 
                                       ) 
                              ) 
                     ) 
                   ) 
              ) 
         ) (abs (car (apply 
                       'mapcar 
                       (cons '- (textbox (list (cons 1 "aa") (cons 7 sty) 
                                               (cons 40 h) (cons 41 scl) 
                                         ) 
                                ) 
                       ) 
                     ) 
                ) 
           ) 
      ) 
    ) 
    (progn 
      (abs (car (apply 
                  'mapcar 
                  (cons '- (textbox (list (cons 1 str) (cons 7 sty) 
                                          (cons 40 h) (cons 41 scl) 
                                    ) 
                           ) 
                  ) 
                ) 
           ) 
      ) 
    ) 
  ) 
)

newer · 发表于 2013-10-15 15:23:00

加入个宽度系数比例吧

st788796 · 发表于 2013-10-15 16:36:11

newer 发表于 2013-10-15 15:23
加入个宽度系数比例吧

已增加 Scalefactor

819534890 · 发表于 2013-10-15 17:12:20

不错，把11行改为cadr，高度也可以获得了，可以宽度、高度一起提供

/db_自贡黄明儒_ · 发表于 2013-10-15 17:19:38

本帖最后由 /db_自贡黄明儒_ 于 2013-10-15 17:24 编辑

看代码，非常不错

eachy · 发表于 2013-10-15 17:32:24

/db_自贡黄明儒_ 发表于 2013-10-15 17:19
看代码，非常不错

应用求一组 String 的最大长度，可以用在做表格的时候计算列宽

(defun XD::String:MaxLen (strl sty h scl)
(apply 'max
(mapcar '(lambda (x)
(xd::string:len sty x h scl)
)
strl
)
)
)

/db_自贡黄明儒_ · 发表于 2013-10-15 17:43:13

楼主再写一段吧，点取文本，判断是点了哪一个字母？

st788796 · 发表于 2013-10-15 17:47:16

/db_自贡黄明儒_ 发表于 2013-10-15 17:43
楼主再写一段吧，点取文本，判断是点了哪一个字母？

这个论坛有, 框选复制文字, 里面有判断位置, 不过里面没有加入 UCS

XDSoft · 发表于 2013-10-15 18:11:46

eachy 发表于 2013-10-15 17:32
应用求一组 String 的最大长度，可以用在做表格的时候计算列宽

这个单独发布吧.

拉契 · 发表于 2014-3-16 17:50:43

楼主的代码好像少了半括号 “)”

cdtyzx · 发表于 2014-3-28 14:58:13

赞一个，好东西谢谢分享

XDSoft · 发表于 2014-12-8 21:35:11

2104.12.08第三版更新，加入了支持纯空格的判断长度

命令: (XD::STRING:ACTUALWIDTH " " "" 500.0 1.0)
388.131

命令: (XD::STRING:ACTUALWIDTH " " "standard" 500.0 1.0)
194.065

命令: (XD::STRING:ACTUALWIDTH " " "standard" 500.0 0.8)
155.252

dyjwyqz5221 · 发表于 2020-5-22 18:05:13

好像缺少东西，如：%%1328@100/150预估的长度与实际相差较远

dyjwyqz5221 · 发表于 2020-5-22 18:06:18

如果相差较大，则在绘制表格时，表格的高度就自动调整了

dyjwyqz5221 · 发表于 2020-5-25 09:56:44

在excel表格里面，如何将%%132转换成**钢钢筋符号的样式，每次生成表格后，都需要炸开，再进行符号转换。shx字体为tssding.shx,大字体为：hztxt.shx

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

[字符串] (XD::String:ActualWidth)获取构造文字长度

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

点评

评分

点评

点评

点评

点评

点评