[LISP程序]：改进的鼠标拖动序号球程序-引线可是LEADER/LINE

lsjjm

改进的鼠标拖动序号球程序-引线可是LEADER/LINE
[php]
(defun c:test (/ leobj liobj)
  (vl-load-com)
  (setq loop t)
  (setq ss (ssget))
  (setq n 0)
  (while (< n (sslength ss))
    (setq obj (vlax-ename->vla-object (ssname ss n)))
    (setq oname (vla-get-ObjectName obj))
    (cond
      ((= oname "AcDbLeader")
        (setq leobj obj p1 (vlax-curve-getstartpoint (ssname ss n))))
      ((= oname "AcDbLine")
        (setq liobj obj p1 (vlax-curve-getstartpoint (ssname ss n))
                        p2 (vlax-curve-getendpoint (ssname ss n))))         
      ((= oname "AcDbCircle")(setq ccobj obj pc (cdr (assoc 10 (entget (ssname ss n))))))
      ((= oname "AcDbText")(setq ttobj obj))
    )
    (setq n (1+ n))
  )  
  (if liobj (if (< (distance p1 pc)(distance p2 pc))(setq p0 p1 p1 p2 p2 p0)))
  (while loop
    (setq p (grread T))
    (if (= (car p) 3)(setq loop nil))
    (vla-put-center ccobj (vlax-3d-point (cadr p)))
    (vla-put-textalignmentpoint ttobj (vlax-3d-point (cadr p)))
    (setq pc (vlax-safearray->list (vlax-variant-value (vla-get-center ccobj))))
    (setq p2 (polar pc (angle pc p1)(vla-get-radius ccobj)))
    (cond
      (leobj
              (setq sl (vlax-make-safearray vlax-vbdouble '(0 . 5)))
        (setq sa (vlax-safearray-fill sl (append p1 p2)))
        (vla-put-coordinates leobj sa)
        (vla-update leobj))
      (liobj
        (vla-put-startpoint liobj (vlax-3d-point p1))
        (vla-put-endpoint liobj (vlax-3d-point p2))
        (vla-update liobj))
    )
  )
)
[/php]

aeo

不就是move命令吗！？

(ssget)选的东西，不能多也不能少，应该先判断.

如果加点其他功能，比如按一键，左右镜像..等等，那你写它才有意义，不然还不如用move.

lsjjm

最初由 aeo 发布
[B]不就是move命令吗！？... [/B]

斑竹说的轻巧!? 你给MOVE个看看?!

梦断江南

最好传一个测试图上来

zjfcumt

没有具体明白是什么意思？可否传张图上来看看？