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

fangmin723

1. ;;说明:移动多段线子段  by Dcl-To-Lsp 663130417群群主 2020年4月9日09:07:52出品
   
2. (defun c:mside(/ ent lst mobj n obj pt)
   
3.    (setq obj (vlax-ename->vla-object (car (setq ent (entsel)))))
   
4.   (setq pt (cadr ent))
   
5.   (setq n (fix (vlax-curve-getParamAtPoint obj (vlax-curve-getClosestPointTo obj pt))))
   
6.   (setq lst (vlax-safearray->list (vlax-variant-value (vla-Explode obj))))
   
7.   (setq mobj (nth n lst))
   
8.   (setq lst (vl-remove mobj lst))
   
9.   (foreach x lst (vla-Delete x))
   
10.   (command "MOVE" (vlax-vla-object->ename mobj) "" pt)
    
11.   ;(vla-Move mobj (vlax-3D-point pt) (vlax-3D-point (getpoint)))
    
12.   (prin1)
    
13. )
    
14. (princ "\nCAD快捷命令《 Mside 》")
    
15. (prin1)

;;说明:移动多段线子段  by Dcl-To-Lsp 663130417群群主 2020年4月9日09:07:52出品<br /> (defun c:mside(/ ent lst mobj n obj pt)<br />    (setq obj (vlax-ename->vla-object (car (setq ent (entsel)))))<br />   (setq pt (cadr ent))<br />   (setq n (fix (vlax-curve-getParamAtPoint obj (vlax-curve-getClosestPointTo obj pt))))<br />   (setq lst (vlax-safearray->list (vlax-variant-value (vla-Explode obj))))<br />   (setq mobj (nth n lst))<br />   (setq lst (vl-remove mobj lst))<br />   (foreach x lst (vla-Delete x))<br />   (command "MOVE" (vlax-vla-object->ename mobj) "" pt)<br />   ;(vla-Move mobj (vlax-3D-point pt) (vlax-3D-point (getpoint)))<br />   (prin1)<br /> )<br /> (princ "\nCAD快捷命令《 Mside 》")<br /> (prin1)

start4444

谢谢分享
来一个通俗 操作的，速度没那么顺
(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)        
)

无名之辈

学习一下