arx吧 关注:32贴子:64
  • 0回复贴,共1

修改多段线第一顶点

取消只看楼主收藏回复

(princ "联系方式:vlisp@vip.qq.com ; QQ:141680\n")
(princ "程序作者:臭儿   \n")
(princ "修改多段线第一顶点执行命令:GGD\n")
(vl-load-com)
(defun c:GGD   (/ en obj p dzb ok-coords oo-coords xshuzu )
     (if (and (setq en (car (entsel "\n选择对象<退出>: ")))
       (setq p (getpoint "\n请选择新起始点:"))
        ;获取线上的点点位,不用getpoint
)
     (progn
       (setq obj (vlax-ename->vla-object en)
       dzb
       (vlax-safearray->list
(vlax-variant-value
    (vla-get-coordinate
      obj
      (fix (vlax-curve-getparamatpoint
      obj
      (vlax-curve-getclosestpointto obj (trans p 1 0)))))))
       ok-coords
       (mapcar 'cdr
        (vl-remove-if-not
   '(lambda (x) (equal (car x) 10))
   (entget en)))
       oo-coords
       (append (vl-remove dzb (member dzb ok-coords))
        (reverse (member dzb (reverse ok-coords))))
      
       )
(vla-put-coordinates obj (vlax-safearray-fill
(vlax-make-safearray
    vlax-vbdouble
    (cons 0 (- (* (length oo-coords) 2) 1)))
(apply 'append oo-coords)))
     ))
   (princ "\n执行结束!作者联系方式:vlisp@vip.qq.com; QQ:141680\n")
   (princ)
   )


IP属地:江苏1楼2010-04-08 17:37回复