社区 › Auto Lisp › 缩放文本和对象任务

dnovember99 发表于 2022-7-5 15:10:02

缩放文本和对象任务

所以我在这里想两件事中的一件。
 
1.我知道AutoCAD有scale（短键SC）命令。选择它，单击一个基点，键入比例因子，就完成了。我想看看我是否能在那里施展拳脚。也许它不会工作，我不确定。但是我们从建筑师那里得到了一个房间名称文件，它们只是单行文本，房间编号周围有一个方框/矩形。我有一个缩放lisp用于缩放块，还有一个用于调整文本大小。但我想要的是能够获取文本和块/对象，并通过选择一次对其进行缩放，然后给出比例因子（例如1/2大小）并完成。
 
2.能够全选并将每个房间名称和房间编号分组到单个块中。然后我可以使用我已经有的缩放lisp。
 
附件是我目前使用的两个LISP。我希望我是在讲道理，而不是在胡说八道。）
缩放文本高度2（TH）。lsp
缩放所有标记2（SX）。lsp

pendean 发表于 2022-7-5 15:20:23

简单地使用注释性块/文本是否是满足这一需求的另一种解决方案？

dnovember99 发表于 2022-7-5 15:27:48

 
 
在这一点上，我认为任何事情都会奏效。问题是，他们以这种方式发送给我们。有没有一种简单的方法可以将这些更改为注释性块/文本？

rlx 发表于 2022-7-5 15:38:41

您可以首先制作一个块/文本（正如pendean所建议的那样），一次性选择所有文本和矩形，并使用文本实体中的字符串和插入点作为块插入点的基础。不知道文本和矩形是否在一个单独的层中，所以你不会选择其他对象。

dnovember99 发表于 2022-7-5 15:41:06

 
我得到了所有这些，但是我正在处理发送给我的内容。他们发给我的不是这样设置的。它只是一行文字，房间号周围有一个正方形。所以我必须进去把每一个都做成一个方块，然后我才能使用我现在拥有的。我只是想知道是否有一种快速的方法可以让他们成为一个街区？或者能够扩展我目前拥有的。附件是发送给我们的内容。
阿南。图纸

rlx 发表于 2022-7-5 15:48:52

我认为，如果你用谷歌搜索“visual lisp text to attribute”，你会发现有几个例程可以做到这一点。

BIGAL 发表于 2022-7-5 16:01:54

Rlx很赚钱，只要做2个区块，因为你有2行和3行的文本。我不确定一个笼统的方法是否可以简单地实现，但如果你喜欢一个do窗口，do窗口，方法，那么阅读文本并替换为一个block将非常容易。我刚刚用你的标签创建了一个匹配并删除了文本的属性。
 
 
作为一个开始玩的东西需要文本角度等检查也需要做真正的工作了。

(defun c:test ( / txt1 txt2 txt3 pt)
(while (setq ss (ssget (list(cons 0 "text"))))
(setq pt (cdr (assoc 10(entget(ssname ss 0)))))
(setq txt1 (cdr (assoc 1(entget(ssname ss 0)))))
(setq txt2 (cdr (assoc 1(entget(ssname ss 0)))))
(if (> (sslength ss) 2)
(progn
(setq txt3 (cdr (assoc 1(entget(ssname ss 0)))))
(command "-insert" "3att" pt 1 1 0 txt1 txt2 txt3) ; 3 att is block name 3 attributes
)
(command "-insert" "2att" pt 1 1 0 txt1 txt2)
)
)
)

Roy_043 发表于 2022-7-5 16:09:56

当然，也可以通过编程方式选择和缩放这些元素簇。
注1：在尝试c:Test之前，请使用\u OverKill命令删除双多段线。
注2：未处理引线。
(defun KGA_Conv_Pickset_To_ObjectList (ss / i ret)
(if ss
   (repeat (setq i (sslength ss))
   (setq ret (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) ret))
   )
)
)

(defun KGA_Geom_ObjectMiddle (obj / ptBL ptTR)
(vla-getboundingbox obj 'ptBL 'ptTR)
(mapcar
   '/
   (mapcar '+ (vlax-safearray->list ptBL) (vlax-safearray->list ptTR))
   '(2.0 2.0 2.0)
)
)

(defun c:Test ( / dis doc lyr polyLst pt restLst scl tab)
(setq dis 40.0)          ; Search distance.
(setq lyr "A-ANNO-NOTE") ; Layer name.
(setq scl 0.5)         ; Scale factor.
(setq tab (if (= 1 (getvar 'cvport)) (getvar 'ctab) "Model"))
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(vla-endundomark doc)
(vla-startundomark doc)
(if
   (and
   (setq polyLst
       (KGA_Conv_Pickset_To_ObjectList
         (ssget "_A" (list (cons 8 lyr) (cons 410 tab) '(0 . "LWPOLYLINE")))
       )
   )
   (setq restLst
       (KGA_Conv_Pickset_To_ObjectList
         (ssget "_A" (list (cons 8 lyr) (cons 410 tab) '(0 . "*TEXT,SPLINE,ELLIPSE")))
       )
   )
   )
   (progn
   (setq restLst
       (mapcar
         '(lambda (obj) (list (KGA_Geom_ObjectMiddle obj) obj))
          restLst
       )
   )
   (foreach poly polyLst
       (setq pt (KGA_Geom_ObjectMiddle poly))
       (vla-scaleentity poly (vlax-3d-point pt) scl)
       (foreach sub restLst
         (if (> dis (distance pt (car sub)))
         (progn
             (vla-scaleentity (cadr sub) (vlax-3d-point pt) scl)
             (setq restLst (vl-remove sub restLst))
         )
         )
       )
   )
   (princ "\nDone! ")
   )
)
(vla-endundomark doc)
(princ)
)

rlx 发表于 2022-7-5 16:15:30

 
 
我正要建议OP看看这个链接：
 
 
http://www.cadtutor.net/forum/showthread.php?101120-Help-with-lisp-to-move-text-to-specific-locations-w-a-better-叙事
 
 
但你的代码是我认为OP需要的。而且很快。干得好，罗伊。现在有太多的工作要做，Lisp程序。。。
 
 
对你来说也是如此！

查看完整版本: 缩放文本和对象任务