（Mside）移动多段线子段 以前不知道在位大师代码中看到过类似的，在这重现一下！
本帖最后由 fangmin723 于 2020-4-9 12:41 编辑;;说明:移动多段线子段by Dcl-To-Lsp 663130417群群主 2020年4月9日09:07:52出品
(defun c:mside(/ ent lst mobj n obj pt)
(setq obj (vlax-ename->vla-object (car (setq ent (entsel)))))
(setq pt (cadr ent))
(setq n (fix (vlax-curve-getParamAtPoint obj (vlax-curve-getClosestPointTo obj pt))))
(setq lst (vlax-safearray->list (vlax-variant-value (vla-Explode obj))))
(setq mobj (nth n lst))
(setq lst (vl-remove mobj lst))
(foreach x lst (vla-Delete x))
(command "MOVE" (vlax-vla-object->ename mobj) "" pt)
;(vla-Move mobj (vlax-3D-point pt) (vlax-3D-point (getpoint)))
(prin1)
)
(princ "\nCAD快捷命令《 Mside 》")
(prin1)
本帖最后由 start4444 于 2020-4-9 11:49 编辑
谢谢分享
来一个通俗 操作的，速度没那么顺
(defun c:tt5 (/ en entname point pt pt1 ss ss1)
(setq en (entsel "\n选择多段线:") entname (car en) pt (cadr en))
(command "point" "nea" pt)
(setq pt1 (cdr (assoc 10 (entget (setq point (entlast))))))
(command "copy" entname "" "non" '(0 0) "non" '(0 0) "EXPLODE" (entlast) "")
(setq ss (ssget "p") ss1 (ssget "c" pt1 pt1 '((0 . "line,arc"))))
(command "copy" ss1 "" "non" pt pause "ERASE" ss point "")
(princ)
)
学习一下
页:
[1]