使用vla getboundin移动文本

Happy Hobbit · 发表于 2022-7-5 18:16:28

这无疑是以前做过的，但我找不到一个简单的（？）lisp将文字对象移动到拾取的x或y值（见图）。
有李Mac的动态文本对齐，但我更喜欢非动态。
还有CAB的alignall，但我有一些问题。

我得到的代码是：

(defun c:mtx ( / ap ent obj point1 point2 ss )
 (vl-load-com)
 (setq ap (getpoint "select alignment point"))
 (setq ss (ssget "_:L" '((0 . "TEXT,MTEXT"))))
 (setq ent (ssname ss 0))
 (setq obj (vlax-ename->vla-object ent))
 (if obj
   (progn
     ;;obj is a vla-object
     ;;point1 is the lower left point of the bounding box around the object
     ;;point2 is the upper right point of the bounding box around the object
     (vla-getboundingbox obj 'point1 'point2)
      ;;point1 and point2 are returned as a safearray and need to be converted to a list
     (setq point1 (vlax-safearray->list point1))
     (setq point2 (vlax-safearray->list point2))
     (command  "_.move" ent "" point1 "_none" (list (car ap) (cadr point1) 0.0))
   );; progn
 );; if
 (princ)
 )

它在移动命令时崩溃

我只添加了ent，因为我认为MOVE命令可能无法在vla对象上工作（？）

Lee Mac · 发表于 2022-7-5 18:29:19

我看不出你当前的代码有什么问题，只是它只会对选择中的第一个对象进行操作；除此之外，它应该按照您所描述的那样执行（至少对于零旋转的文本/多行文字，并且位于与WCS平面平行的平面中）。

忽略UCS和旋转问题，您可能会发现以下方式有助于重新构造代码，以便在指定新位置时，可以将左下角点用作视觉辅助：

copy

(defun c:mtx ( / bpt llp sel urp )
   (if (setq sel (ssget "_+.:E:S:L" '((0 . "TEXT,MTEXT"))))
       (progn
           (vla-getboundingbox (vlax-ename->vla-object (ssname sel 0)) 'llp 'urp)
           (setq llp (vlax-safearray->list llp))
           (if (setq bpt (getpoint "\nSpecify alignment point: " llp))
               (command "_.move" sel "" "_non" (list (car llp) 0.0) "_non" (list (car bpt) 0.0))
           )
       )
   )
   (princ)
)
(vl-load-com) (princ)

Happy Hobbit · 发表于 2022-7-5 18:36:57

你好，李
它不起作用！我打算把它放在一个重复的循环中，从

copy

ssget "_:L

和通常递增的ssname函数等。因此我的代码中有ent函数。我总是先让代码在单个项目上运行，然后再围绕它进行循环。我看到您的代码从ssget中移动了选择集（目前为单个项），而不是结果实体。类似于：

但是它还没有工作。
所以，我将把选择对齐点放在代码的顶部，然后重复循环，并在循环的每个回合中移动所有选定的合格实体。