[LISP程序]：批量处理离圆最近的文本对齐圆中心

lsjjm

批量处理离圆最近的文本对齐圆中心
[php]
(defun c:test ( / ssl ttl ntt)
  ;(vl-load-com)
  (setq ss (ssget '((0 . "CIRCLE,TEXT"))))
  (foreach i (acet-ss-to-list ss)
    (if (= (cdr (assoc 0 (entget i))) "CIRCLE")
      (setq ssl (cons i ssl))
      (setq ttl (cons i ttl))
    )
  )
  (foreach i ssl
    (setq pc (cdr (assoc 10 (entget i))))
    (setq ntt
      (vl-sort ttl
        (function
          (lambda (e1 e2)(< (distance pc (cdr (assoc 10 (entget e1))))
                            (distance pc (cdr (assoc 10 (entget e2)))))
          )
        )
      )
    )
    (setq obj (vlax-ename->vla-object (car ntt)))
    (vla-put-alignment obj 4)
    (vla-put-TextAlignmentPoint obj (vlax-3d-point pc))
  )
)
[/php]