乐筑天下

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

[编程交流] 文字拟合lisp

[复制链接]

31

主题

106

帖子

76

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
154
发表于 2022-7-5 13:54:52 | 显示全部楼层
非常感谢你。它适用于将justify设置为中间中心的文本。但是,如果将justify设置为其他值,则会将文本移到框外。
回复

使用道具 举报

114

主题

1万

帖子

1万

银币

中流砥柱

Rank: 25

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

使用道具 举报

31

主题

106

帖子

76

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
154
发表于 2022-7-5 13:58:50 | 显示全部楼层
这非常有效!非常感谢你。
 
现在,我尝试扩展这个例程,使其指向对象内部,而不是选择对象,因此它可以处理重叠的对象。想到命令边界:
然而,由于某些原因,脚本没有超出边界命令,它只是停止。知道为什么吗?
 
非常感谢。
回复

使用道具 举报

31

主题

106

帖子

76

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
154
发表于 2022-7-5 14:02:32 | 显示全部楼层
那是一个掌心。。。所有这些命令都在(和…)的内部边界命令返回nil。
这似乎现在起作用了:
如果是tex,则发现一个问题
142030e15bor87vlyoh8eh.png
回复

使用道具 举报

31

主题

106

帖子

76

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
154
发表于 2022-7-5 14:07:06 | 显示全部楼层
Can anyone help with angled text?
 
Thank you.
回复

使用道具 举报

31

主题

106

帖子

76

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
154
发表于 2022-7-5 14:08:19 | 显示全部楼层
I think I fixed it, thanks Lee Mac for bounding box routine:
  1. (DEFUN c:tfit (/ ln pl pt tx)   (AND       (SETQ tx (LM:selectifobject "\nSelect text: " "TEXT"));        (setq pl (LM:selectifobject "\nSelect polyline: " "LWPOLYLINE"))       (SETQ pl (GETPOINT "\nSelect a point: ")       )       (tfit (ENTGET tx) pl)   )   (PRINC))(DEFUN tfit (tx pl / tb vc x)   (SETVAR "cmdecho" 0)   (AND       tx       pl       (NOT (COMMAND "-boundary" pl ""))       (SETQ pl (ENTLAST))       (SETQ pl (MAPCAR 'CDR (VL-REMOVE-IF-NOT '(LAMBDA (x) (= 10 (CAR x))) (ENTGET pl)))             pl (MAPCAR '(LAMBDA (x) (APPLY 'MAPCAR (CONS x pl))) '(MIN MAX))       )       (NOT (COMMAND "_.undo" ""))       (ENTMOD           (SUBST               (CONS 40                     (* (CDR (ASSOC 40 tx))                        0.9 ; Alter this to suit                        (APPLY 'MIN                               (MAPCAR '/                                       (APPLY 'MAPCAR (CONS '- (REVERSE pl)))                                       (APPLY 'MAPCAR (CONS '- (REVERSE (_TEXTBOX tx nil))))                               )                        )                     )               )               (ASSOC 40 tx)               tx           )       )       (SETQ tx  (ENTGET (CDR (ASSOC -1 tx)))             tb  (_TEXTBOX tx nil)             vc  (MAPCAR '- (avgpt pl) (MAPCAR '+ (CDR (ASSOC 10 tx)) (avgpt tb)))             add (MAPCAR '- (CDR (ASSOC 10 tx)) (CAR (_textbox tx T)))       )       (ENTMOD           (SUBST (CONS 10 (MAPCAR '+ (CDR (ASSOC 10 tx)) vc add))                  (ASSOC 10 tx)                  (SUBST (CONS 11 (MAPCAR '+ (CDR (ASSOC 11 tx)) vc add)) (ASSOC 11 tx) tx)           )       )   )   (SETVAR "cmdecho" 1)   (PRINC))(DEFUN avgpt (lst)   (MAPCAR '/ (APPLY 'MAPCAR (CONS '+ lst)) (LIST 2 2)));; Select if Object  -  Lee Mac;; Continuously prompts the user for a selection of a specific object(DEFUN LM:selectifobject (msg obj / ent)   (WHILE       (PROGN (SETVAR 'errno 0)              (SETQ ent (CAR (ENTSEL msg)))              (COND                  ((= 7 (GETVAR 'errno))                   (PRINC "\nMissed, try again.")                  )                  ((= 'ename (TYPE ent))                   (IF (/= obj (CDR (ASSOC 0 (ENTGET ent))))                       (PRINC "\nInvalid Object Selected.")                   )                  )              )       )   )   ent);; Selection Set Bounding Box  -  Lee Mac;; Returns a list of the lower-left and upper-right WCS coordinates of a;; rectangular frame bounding all objects in a supplied selection set.;; s - [sel] Selection set for which to return bounding box(DEFUN _textbox (s coords / a b c m n o ll ur)   (SETQ a nil         b nil         m nil         n nil   )   (SETQ o (VLAX-ENAME->VLA-OBJECT (CDR (ASSOC -1 s))))   (IF (AND o            (VLAX-METHOD-APPLICABLE-P o 'getboundingbox)            (NOT (VL-CATCH-ALL-ERROR-P                     (VL-CATCH-ALL-APPLY 'VLA-GETBOUNDINGBOX (LIST o 'a 'b))                 )            )       )       (SETQ m (CONS (VLAX-SAFEARRAY->LIST a) m)             n (CONS (VLAX-SAFEARRAY->LIST b) n)       )   )   (SETQ c  (MAPCAR '(LAMBDA (a b) (APPLY 'MAPCAR (CONS a b))) '(MIN MAX) (LIST m n))         ll (CAR c)         ur (CADR c)   )   (IF (NOT coords)       (SETQ c (LIST (LIST 0 0 (NTH 2 (CAR c)))                     (LIST (ABS (- (CAR ll) (CAR ur)))                           (ABS (- (CADR ll) (CADR ur)))                           (NTH 2 (CADR c))                     )               )       )   )   c)
回复

使用道具 举报

0

主题

3

帖子

3

银币

初来乍到

Rank: 1

铜币
0
发表于 2022-7-5 14:10:47 | 显示全部楼层
Hi There
 
Is it possible to make Lee`s code for mtexts?
 
Thanks...
回复

使用道具 举报

31

主题

106

帖子

76

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
154
发表于 2022-7-5 14:13:57 | 显示全部楼层
All of the sudden the last code I posted above stopped working, it now gets error "divide by zero", pointing to
  1.                                (MAPCAR '/                                       (APPLY 'MAPCAR (CONS '- (REVERSE pl)))                                       (APPLY 'MAPCAR (CONS '- (REVERSE (_TEXTBOX tx nil))))                               )
 
        Any ideas why?
回复

使用道具 举报

28

主题

317

帖子

292

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
140
发表于 2022-7-5 14:20:09 | 显示全部楼层
divide by 0 error is (drum roll) because you divide by zero!
        adding a little surveillance cam like this
  1.                                (MAPCAR '/                                       (setq tmp1 (APPLY 'MAPCAR (CONS '- (REVERSE pl))))                                       (setq tmp2 (APPLY 'MAPCAR (CONS '- (REVERSE (_TEXTBOX tx nil)))))                               )
which after crash help me retrieve tmp1 and tmp2. Here's what is in them
        Command: !tmp1
        (0.0 0.0 0.0)
        Command: !tmp2
        (0.729203 0.242907 0.0)
        the mapcar divide the 1rst element of tmp1 by  the 1rst element of tmp2 (0.0 / 0.729203)
        the mapcar then divide the 2nd element of tmp1 by  the 2nd element of tmp2 (0.0 / 0.242907)
        the mapcar then divide the 3rd element of tmp1 by  the 3rd element of tmp2 (0.0 / 0.0). (bombs here...)
         
        I always had that same values in tmp1/tmp2 no matter the position of of the text. After digging out to understand the code, here'S what I found out. The problem is the boundary command. If if fails to create a boundary, entlast will retrieve something else (in my case the text). a pline will have only 2 sets of coords in assoc 10, so tmp1 has 2 elements, so the 3rd element of tmp2, which is 0 is ignored.
        ie: (mapcar '/ '(10 10)'(2 2 0)) returns (5 5)
        When boundary fails to be created, in my case the text was selected, which has a set of x y z coords. When it happens, here' what is in PL just before you try to mapcar the division
        ((226.922 97.1085 0.0) (226.922 97.1085 0.0))
        What you could do, get/store the entlast before boundary. After boundary, if the "new" entlast is different the one that you stored, proceed, else you know the boundary creation failed, and could prompt a message before quitting.
回复

使用道具 举报

31

主题

106

帖子

76

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
154
发表于 2022-7-5 14:21:48 | 显示全部楼层
In my case the boundary being created successfully (creates POLYLINE on top of LWPOLYLINE) , it's for some reason coordinates of it in assoc 10 is (0.0 0.0 0.0)
        In fact there is no any coordinates available in that boundary polyline:
  1. ((-1 . ) (0 . "POLYLINE") (330 . ) (5 . "196") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0")(100 . "AcDb2dPolyline") (66 . 1) (10 0.0 0.0 0.0) (70 . 1) (40 . 0.0) (41 .0.0) (210 0.0 0.0 1.0) (71 . 0) (72 . 0) (73 . 0) (74 . 0) (75 . 0))
 
        This used to work flawlessly before, there must be some setting I've changed that broke it...
回复

使用道具 举报

发表回复

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

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

GMT+8, 2025-3-15 07:26 , Processed in 0.597782 second(s), 72 queries .

© 2020-2025 乐筑天下

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