**Lisp例程移动文本或

BIGAL · 发表于 2022-7-5 16:09:41

罗恩琼普
文本不一定已经在两点附近，因此交叉ssget将选择其他内容或可能什么都没有，将需要3个选择文本&p1 p2，就像您的带有边界框的中间想法将用作库例程一样。


;; Ronjonp - 03.22.2018 mid pt of two pts
(defun _mid (p1 p2) (polar p1 (angle p1 p2) (/ (distance p1 p2) 2.)))
; modified by Alan H basicly supports any object that can have a bounding box 03.23.2018
(defun c:foo (/ e p p1 p2)
(setq e (vlax-ename->vla-object (car (entsel "pick object"))))
(vla-getboundingbox e 'll 'ur)
(setq p (mapcar 'vlax-safearray->list (list ll ur)))
(setq p1 (getpoint "pick 1st point"))
(setq p2 (getpoint "pick 2nd point"))
(vlax-invoke e 'move (_mid (car p) (cadr p)) (_mid p1 p2))
(princ)
)
(vl-load-com)
(c:foo)

在块、*文本、对象、线条等上测试

ronjonp · 发表于 2022-7-5 16:13:23

我的代码基于示例图形，因此应该可以工作。

BIGAL · 发表于 2022-7-5 16:18:10

Ronjonp这个问题确实可以通过使用一个表来解决，这就是你所暗示的，中心文本在一个表中得到支持。我并没有看示例dwg，而是将其按面值移动到一个点。我相信它会有用的。

关于形状中的数字，你可以得到TTF，它可以做这类事情，我认为它的丁蝙蝠在一个圆圈中有0-9，但我有一个TTF，它允许数字10+它使它成为两部分文本7+5=75

再想一想重新采样dwg，1个拾取可能全部完成！

选取文字，做一个多边形，这样可以得到文字的角点。唯一的问题是文本选取点必须在矩形内。然后在文本框外执行bpoly-左下角一个分数？

如果我可以手动到达某个地方，那么就开始se

copy


(setq ent (entsel))
(setq pt (cadr ent))
(command "bpoly" pt "")
(setq obj1 (vlax-ename->vla-object (entlast)))
(vla-getboundingbox obj1 'll 'ur)
(setq p (mapcar 'vlax-safearray->list (list ll ur)))
(setq p3 (list ( - (car (nth 0 p)) 0.00001) (cadr (nth 0 p))))
(command "bpoly" p3 "")
(setq obj2 (vlax-ename->vla-object (entlast)))
(vla-getboundingbox obj2 'll 'ur)
(setq p2 (mapcar 'vlax-safearray->list (list ll ur)))

ronjonp · 发表于 2022-7-5 16:21:16

我确信可以编写代码来一次性清理表，但我现在没有时间。此外，我仍然觉得制作桌子的过程需要自动化，但那只是我（我非常不耐烦和懒惰）。

hanhphuc · 发表于 2022-7-5 16:26:14

周末曾经是懒散的心情
谢谢好主意-BIGAL bpoly
打嗝：如果一个单元格中有两个以上的文本实体，则所有实体都重叠

请仅在外框处单击。。

copy


(vl-load-com)
(defun c:m2cen (/ ss en i lp pl tx p obj box ll rr)
;hanhphuc 23.03.2018 
 (and 
   (while (not ss)
     (setq
ss (ssget "_:S:E+."
          '((0 . "LWPOLYLINE") (-4 . "&=") (70 . 1) (90 . 4))
   )
     )
   )
   (setq lp '((en)(mapcar 'cdr (vl-remove-if ''((x) (/= (car x) 10)) (entget en))))
  en  (ssname ss 0)
  pl (lp en)
             tx (ssget "_WP" (mapcar ''((x)(trans x en 1)) pl) '((0 . "*TEXT"))))
   (repeat (setq i (sslength tx))
     (setq obj (vlax-ename->vla-object (ssname tx (setq i (1- i) )))
    p         (vlax-get obj 'InsertionPoint))
           (if (vlax-property-available-p obj 'AttachmentPoint)
         (vla-put-AttachmentPoint obj 5)
      )
     (and
(setq box (bpoly (trans p 0 1)))
(setq pl (lp box)
      mp
         (reverse
           (cons
             0.0
             (mapcar ''((f) (/ (apply '+ (mapcar 'f pl)) (length pl)))
                     (list cadr car)
             )
           )
         )
)
(entdel box)
(progn
  (vla-getboundingbox obj 'll 'ur)
  (vlax-invoke
    obj
    'move
    (apply 'mapcar
           (cons ''((a b) (* (+ a b) 0.5))
                 (mapcar 'vlax-safearray->list (list ll ur))
           )
    )         
         mp
  )
)
     )
   )
 )
 (princ)
)

为什么@OP不使用内置（命令：table）来填充数据？
我更喜欢activeX自动添加方法更简单、更灵活

BIGAL · 发表于 2022-7-5 16:30:30

Hanhpuc你的右边实际上忘记了我已经做过的一件事，那就是在pline中查找文本，所以只需在文本附近拾取，这使框成为一个多边形，并允许使用带两个点的“C”来查找txt，同样是一个单次拾取，如果txt位于左下角并且正好位于一行上方，这也解决了一个问题。关于两篇文章，你是对的，需要测试。

[编程交流] **Lisp例程移动文本或

发表回复

精选推荐