（Mside）移动多段线子段以前不知道在位大师代码中看到过类似的，在这重现一下！

fangmin723 · 发表于 2020-4-9 09:27

本帖最后由 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 10:29

本帖最后由 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)
)

无名之辈 · 发表于 2020-4-10 17:53

学习一下

账号		自动登录	找回密码
密码			注册

[源码] （Mside）移动多段线子段以前不知道在位大师代码中看到过类似的，在这重现一下！

评分

[源码] （Mside）移动多段线子段 以前不知道在位大师代码中看到过类似的，在这重现一下！

评分

[源码] （Mside）移动多段线子段以前不知道在位大师代码中看到过类似的，在这重现一下！