乐筑天下

搜索
欢迎各位开发者和用户入驻本平台 ☆ ☆ ☆ 尊重版权，从我做起，拒绝盗版，拒绝倒卖 ☆ ☆ ☆ 签到、发布资源、邀请好友注册，可以获得银币 ☆ ☆ ☆ 请注意保管好自己的密码，避免账户资金被盗
查看： 77|回复： 19

[编程交流] 文字拟合lisp

[复制链接]
BrianTFC

39

主题

180

帖子

141

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
195
发表于 2022-7-5 13:20:12 | 显示全部楼层 |阅读模式
大家好，
 
我想知道是否有一个lisp例程，当你把一个dtext字符串放到一个矩形中时，它会缩小到适合里面？我查看了express工具中的“文字拟合”命令，但它只会收缩或拉伸长度。
 
谢谢
布瑞恩
回复

使用道具 举报

BIGAL

106

主题

1万

帖子

101

银币

顶梁支柱

Rank: 50Rank: 50

铜币
1299
发表于 2022-7-5 13:26:30 | 显示全部楼层
文本属性之一是宽度因子，因此对于矩形，将文本高度设置为矩形高度宽度因子可能需要一个模糊因子，因为III与AAA的长度不同，因此取决于实际文本内容，这称为紧排。我会做一些像+或-或=重复接受的事情来获得效果。可能搜索Kern文本
 
使用多行文字和备用文本编辑器（带扩展（或收缩）字母间距的\T修饰符）发现此问题。
回复

使用道具 举报

hmsilva

1

主题

475

帖子

481

银币

初来乍到

Rank: 1

铜币
5
发表于 2022-7-5 13:27:40 | 显示全部楼层
布莱恩，
“快速工具”命令“文本拟合”使用宽度因子收缩或拉伸文本字符串以匹配所需的长度，如果我理解正确，您还需要高度匹配。
也许是这样的
 
  2. (defun c:test (/      ss     esel   txtobj old_osm  ll ur
  3.        ll1    ur1    llpt   urpt   ulpt   brpt  llpt1 urpt1
  4.        ulpt1  brpt1  scf    nscf
  5.       )
  6.  (prompt "\n Select the rectangle to fit text inside: ")
  7.  (if
  8.    (and (setq ss (ssget "_:S:E" '((0 . "LWPOLYLINE"))))
  9.  (setq esel (entsel "\nSelect the text to fit in the rectangle: "))
  10.    )
  11.     (progn
  12.       (setq txtobj (vlax-ename->vla-object (car esel)))
  13.       (if (equal (vla-get-ObjectName txtobj) "AcDbText")
  14.  (progn
  15.    (setq old_osm (getvar "osmode"))
  16.    (setvar "osmode" 0)
  17.    (vla-getboundingbox
  18.      (vlax-ename->vla-object (ssname ss 0))
  19.      'll
  20.      'ur
  21.    )
  22.    (vla-getboundingbox txtobj 'll1 'ur1)
  23.    (setq llpt  (trans (vlax-safearray->list ll) 0 1)
  24.   urpt  (trans (vlax-safearray->list ur) 0 1)
  25.   ulpt  (list (car llpt) (cadr urpt) (caddr urpt))
  26.   brpt  (list (car urpt) (cadr llpt) (caddr llpt))
  27.   llpt1 (trans (vlax-safearray->list ll1) 0 1)
  28.    )
  29.    ;; setq
  30.    (vl-cmdf "move" (car esel) "" llpt1 llpt)
  31.    (vla-update txtobj)
  32.    (vla-getboundingbox txtobj 'll1 'ur1)
  33.    (setq llpt1 (trans (vlax-safearray->list ll1) 0 1)
  34.   urpt1 (trans (vlax-safearray->list ur1) 0 1)
  35.   ulpt1 (list (car llpt1) (cadr urpt1) (caddr urpt1))
  36.    )
  37.    ;; setq
  38.    (vl-cmdf "scale" (car esel) "" llpt "R" "@" ulpt1 ulpt "")
  39.    (vla-update txtobj)
  40.    (vla-getboundingbox txtobj 'll1 'ur1)
  41.    (setq llpt1 (trans (vlax-safearray->list ll1) 0 1)
  42.   urpt1 (trans (vlax-safearray->list ur1) 0 1)
  43.   brpt1 (list (car urpt1) (cadr llpt1) (caddr llpt1))
  44.   scf   (vla-get-scalefactor txtobj)
  45.   nscf  (/ (* (distance llpt brpt) scf) (distance llpt1 brpt1))
  46.    )
  47.    ;; setq
  48.    (vla-put-scalefactor txtobj nscf)
  49.    (setvar "osmode" old_osm)
  50.  )
  51.  ;; progn
  52.       )
  53.       ;; if
  54.     )
  55.     ;; progn
  56.  )
  57.  ;; if
  58. )

 
亨里克
回复

使用道具 举报

BrianTFC

39

主题

180

帖子

141

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
195
发表于 2022-7-5 13:31:31 | 显示全部楼层
亨里克，
 
我想知道是否有办法缩小文本以适应内部，而不是拉伸和收缩以适应？
 
谢谢
布瑞恩
 
142014ps1fx22cvnl2o25n.jpg
文本收缩。图纸
回复

使用道具 举报

Lee Mac

114

主题

1万

帖子

1万

银币

中流砥柱

Rank: 25

铜币
543
发表于 2022-7-5 13:35:44 | 显示全部楼层
尝试以下快速编写的代码：
 
  2. ([color=BLUE]defun[/color] c:tfit ( [color=BLUE]/[/color] ln pl pt tx )
  3.    ([color=BLUE]if[/color]
  4.        ([color=BLUE]and[/color]
  5.            ([color=BLUE]setq[/color] pl (LM:selectifobject [color=MAROON]"\nSelect LWPolyline: "[/color] [color=MAROON]"LWPOLYLINE"[/color]))
  6.            ([color=BLUE]setq[/color] tx (LM:selectifobject [color=MAROON]"\nSelect Text: "[/color] [color=MAROON]"TEXT"[/color]))
  7.            ([color=BLUE]setq[/color] pl ([color=BLUE]mapcar[/color] '[color=BLUE]cdr[/color] ([color=BLUE]vl-remove-if-not[/color] '([color=BLUE]lambda[/color] ( x ) ([color=BLUE]=[/color] 10 ([color=BLUE]car[/color] x))) ([color=BLUE]entget[/color] pl)))
  8.                  ln ([color=BLUE]length[/color] pl)
  9.                  pt ([color=BLUE]mapcar[/color] '[color=BLUE]/[/color] ([color=BLUE]apply[/color] '[color=BLUE]mapcar[/color] ([color=BLUE]cons[/color] '[color=BLUE]+[/color] pl)) ([color=BLUE]list[/color] ln ln))
  10.                  tx ([color=BLUE]entget[/color] tx)
  11.            )
  12.        )
  13.        ([color=BLUE]entmod[/color]
  14.            ([color=BLUE]subst[/color] '(72 . 1) ([color=BLUE]assoc[/color] 72 tx)
  15.                ([color=BLUE]subst[/color] '(73 . 2) ([color=BLUE]assoc[/color] 73 tx)
  16.                    ([color=BLUE]subst[/color] ([color=BLUE]cons[/color] 10 pt) ([color=BLUE]assoc[/color] 10 tx)
  17.                        ([color=BLUE]subst[/color] ([color=BLUE]cons[/color] 11 pt) ([color=BLUE]assoc[/color] 11 tx)
  18.                            ([color=BLUE]subst[/color]
  19.                                ([color=BLUE]cons[/color] 40
  20.                                    ([color=BLUE]*[/color] [highlight]0.8 [color=GREEN];; Text Gap[/highlight][/color]
  21.                                        ([color=BLUE]-[/color]
  22.                                            ([color=BLUE]cadr[/color] ([color=BLUE]apply[/color] '[color=BLUE]mapcar[/color] ([color=BLUE]cons[/color] '[color=BLUE]max[/color] pl)))
  23.                                            ([color=BLUE]cadr[/color] ([color=BLUE]apply[/color] '[color=BLUE]mapcar[/color] ([color=BLUE]cons[/color] '[color=BLUE]min[/color] pl)))
  24.                                        )
  25.                                    )
  26.                                )
  27.                                ([color=BLUE]assoc[/color] 40 tx)
  28.                                tx
  29.                            )
  30.                        )
  31.                    )
  32.                )
  33.            )
  34.        )
  35.    )
  36.    ([color=BLUE]princ[/color])
  37. )
  38.    
  39. [color=GREEN];; Select if Object  -  Lee Mac[/color]
  40. [color=GREEN];; Continuously prompts the user for a selection of a specific object[/color]
  42. ([color=BLUE]defun[/color] LM:SelectifObject ( msg obj [color=BLUE]/[/color] ent )
  43.    ([color=BLUE]while[/color]
  44.        ([color=BLUE]progn[/color] ([color=BLUE]setvar[/color] 'errno 0) ([color=BLUE]setq[/color] ent ([color=BLUE]car[/color] ([color=BLUE]entsel[/color] msg)))
  45.            ([color=BLUE]cond[/color]
  46.                (   ([color=BLUE]=[/color] 7 ([color=BLUE]getvar[/color] 'errno))
  47.                    ([color=BLUE]princ[/color] [color=MAROON]"\nMissed, try again."[/color])
  48.                )
  49.                (   ([color=BLUE]=[/color] 'ename ([color=BLUE]type[/color] ent))
  50.                    ([color=BLUE]if[/color] ([color=BLUE]/=[/color] obj ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 0 ([color=BLUE]entget[/color] ent))))
  51.                        ([color=BLUE]princ[/color] [color=MAROON]"\nInvalid Object Selected."[/color])
  52.                    )
  53.                )
  54.            )
  55.        )
  56.    )
  57.    ent
  58. )
  59. ([color=BLUE]princ[/color])

 
如有必要，调整突出显示的文字间距。
回复

使用道具 举报

BrianTFC

39

主题

180

帖子

141

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
195
发表于 2022-7-5 13:38:13 | 显示全部楼层
李，
 
这正是我想要的，在看了你的代码后，我找到了一行，如果我需要把文本缩小，我可以。我真的很感谢你们在CadForum上给我的帮助。我正在慢慢地但肯定地学习如何编写小的简单例程，但我在阅读代码和学习每一行通过可视化Lisp编辑器所做的事情方面越来越好，Henrique aka（hmsilvia）向我展示了如何为Lisp例程设置动画，以便我能够理解它的工作原理。
 
再次感谢各位，
布瑞恩
回复

使用道具 举报

Lee Mac

114

主题

1万

帖子

1万

银币

中流砥柱

Rank: 25

铜币
543
发表于 2022-7-5 13:40:22 | 显示全部楼层
欢迎您，Brian，当然，如果您对代码有任何问题，请提问。
回复

使用道具 举报

vanowm

31

主题

106

帖子

76

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
154
发表于 2022-7-5 13:42:41 | 显示全部楼层
你好
 
李，谢谢你的代码，它可以工作，但不是在所有情况下都可以。例如：

                               
登录/注册后可看大图

                               
登录/注册后可看大图


                               
登录/注册后可看大图
回复

使用道具 举报

Lee Mac

114

主题

1万

帖子

1万

银币

中流砥柱

Rank: 25

铜币
543
发表于 2022-7-5 13:47:45 | 显示全部楼层
以下情况可能会更好：
  2. ([color=BLUE]defun[/color] c:tfit ( [color=BLUE]/[/color] ln pl pt tx )
  3.    ([color=BLUE]if[/color]
  4.        ([color=BLUE]and[/color]
  5.            ([color=BLUE]setq[/color] tx (LM:selectifobject [color=MAROON]"\nSelect text: "[/color] [color=MAROON]"TEXT"[/color]))
  6.            ([color=BLUE]setq[/color] pl (LM:selectifobject [color=MAROON]"\nSelect polyline: "[/color] [color=MAROON]"LWPOLYLINE"[/color]))
  7.            ([color=BLUE]setq[/color] pl ([color=BLUE]mapcar[/color] '[color=BLUE]cdr[/color] ([color=BLUE]vl-remove-if-not[/color] '([color=BLUE]lambda[/color] ( x ) ([color=BLUE]=[/color] 10 ([color=BLUE]car[/color] x))) ([color=BLUE]entget[/color] pl)))
  8.                  pl ([color=BLUE]mapcar[/color] '([color=BLUE]lambda[/color] ( x ) ([color=BLUE]apply[/color] '[color=BLUE]mapcar[/color] ([color=BLUE]cons[/color] x pl))) '([color=BLUE]min[/color] [color=BLUE]max[/color]))
  9.                  tx ([color=BLUE]entget[/color]  tx)
  10.                  tb ([color=BLUE]textbox[/color] tx)
  11.                  vc ([color=BLUE]mapcar[/color] '[color=BLUE]-[/color] (avgpt pl) ([color=BLUE]mapcar[/color] '[color=BLUE]+[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 10 tx)) (avgpt tb)))
  12.            )
  13.        )
  14.        ([color=BLUE]entmod[/color]
  15.            ([color=BLUE]subst[/color] '(72 . 1) ([color=BLUE]assoc[/color] 72 tx)
  16.                ([color=BLUE]subst[/color] '(73 . 2) ([color=BLUE]assoc[/color] 73 tx)
  17.                    ([color=BLUE]subst[/color] ([color=BLUE]cons[/color] 11 ([color=BLUE]mapcar[/color] '[color=BLUE]+[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 11 tx)) vc)) ([color=BLUE]assoc[/color] 11 tx)
  18.                        ([color=BLUE]subst[/color]
  19.                            ([color=BLUE]cons[/color] 40
  20.                                ([color=BLUE]*[/color]  ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 40 tx)) [highlight]0.9 [color=green];; Alter this to suit[/color][/highlight]
  21.                                    ([color=BLUE]apply[/color] '[color=BLUE]min[/color]
  22.                                        ([color=BLUE]mapcar[/color] '[color=BLUE]/[/color]
  23.                                            ([color=BLUE]apply[/color] '[color=BLUE]mapcar[/color] ([color=BLUE]cons[/color] '[color=BLUE]-[/color] ([color=BLUE]reverse[/color] pl)))
  24.                                            ([color=BLUE]apply[/color] '[color=BLUE]mapcar[/color] ([color=BLUE]cons[/color] '[color=BLUE]-[/color] ([color=BLUE]reverse[/color] ([color=BLUE]textbox[/color] tx))))
  25.                                        )
  26.                                    )
  27.                                )
  28.                            )
  29.                            ([color=BLUE]assoc[/color] 40 tx) tx
  30.                        )
  31.                    )
  32.                )
  33.            )
  34.        )
  35.    )
  36.    ([color=BLUE]princ[/color])
  37. )
  39. ([color=BLUE]defun[/color] avgpt ( lst )
  40.    (([color=BLUE]lambda[/color] ( len ) ([color=BLUE]mapcar[/color] '[color=BLUE]/[/color] ([color=BLUE]apply[/color] '[color=BLUE]mapcar[/color] ([color=BLUE]cons[/color] '[color=BLUE]+[/color] lst)) ([color=BLUE]list[/color] len len))) ([color=BLUE]length[/color] lst))
  41. )
  42.    
  43. [color=GREEN];; Select if Object  -  Lee Mac[/color]
  44. [color=GREEN];; Continuously prompts the user for a selection of a specific object[/color]
  46. ([color=BLUE]defun[/color] LM:selectifobject ( msg obj [color=BLUE]/[/color] ent )
  47.    ([color=BLUE]while[/color]
  48.        ([color=BLUE]progn[/color] ([color=BLUE]setvar[/color] 'errno 0) ([color=BLUE]setq[/color] ent ([color=BLUE]car[/color] ([color=BLUE]entsel[/color] msg)))
  49.            ([color=BLUE]cond[/color]
  50.                (   ([color=BLUE]=[/color] 7 ([color=BLUE]getvar[/color] 'errno))
  51.                    ([color=BLUE]princ[/color] [color=MAROON]"\nMissed, try again."[/color])
  52.                )
  53.                (   ([color=BLUE]=[/color] 'ename ([color=BLUE]type[/color] ent))
  54.                    ([color=BLUE]if[/color] ([color=BLUE]/=[/color] obj ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 0 ([color=BLUE]entget[/color] ent))))
  55.                        ([color=BLUE]princ[/color] [color=MAROON]"\nInvalid Object Selected."[/color])
  56.                    )
  57.                )
  58.            )
  59.        )
  60.    )
  61.    ent
  62. )
  63. ([color=BLUE]princ[/color])
回复

使用道具 举报

Lee Mac

114

主题

1万

帖子

1万

银币

中流砥柱

Rank: 25

铜币
543
发表于 2022-7-5 13:49:43 | 显示全部楼层
更新后的程序还好吗？
回复

使用道具 举报

12下一页
返回列表 发帖

发表回复

高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

精选推荐

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

QQ|关于我们|小黑屋|乐筑天下 繁体中文

GMT+8, 2025-3-14 23:30 , Processed in 1.285383 second(s), 74 queries .

© 2020-2025 乐筑天下

联系客服 关注微信 帮助中心 下载APP 返回顶部 返回列表