【转帖】修改多段线第一顶点 - 精华帖集合
 

修改多段线第一顶点 - 精华帖集合
www.dimcax.com
修改多段线第一顶点
,
(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)
)
嗯，有趣
(if (and (setq en (car (entsel "\n选择对象<退出>: ")))
可以不用and的
-=finale=-