;; Copy a user selected section of an entity http://www.theswamp.org/index.php?topic=10341.0
;; CAB 05/31/06
;; Pick 2 clip points then pick new location for copied entity segment
(defun c:plc ( / end1 end2 endpt p1 p2 pk1 pk2 strpt)
(princ "\n ** Select: CCW ** ")
(vl-load-com)
(command "._undo" "_begin")
(defun dtrim ()
(command "._copybase" "_non" p1 ent1 "")
(command "._pasteclip" "_non" p1)
(command "._break" (list ent1 p1) end1)
(command "._break" (list ent1 p2) end2)
(command "._copybase" "_non" p2 ent1 "")
(command "._pasteclip" "\\") ;;"_non" moved out of progn hoping to further stabilize
)
(if (and
(setq pk1 (entsel "\n Pick First Polyline Trim Point."))
(setq pk2 (entsel "\n Pick Second Polyline Trim Point."))
(eq (car pk1) (car pk2))
(setq ent1 (car pk1))
(setq p1 (vlax-curve-getClosestPointTo (car pk1) (cadr pk1)))
(setq p2 (vlax-curve-getClosestPointTo (car pk2) (cadr pk2)))
(setq endpt (vlax-curve-getendpoint (car pk1)))
(setq strpt (vlax-curve-getstartpoint (car pk1))) ;; ch to pk2..
(if (< (vlax-curve-getDistAtPoint (car pk1) p1)
(vlax-curve-getDistAtPoint (car pk2) p2)
)
(setq end1 strpt end2 endpt)
(setq end2 strpt end1 endpt)
)
)
(dtrim)
)
(command "._undo" "_end")
(princ)
)
;; ptrim was at end..
; (progn
; (command "._copybase" "_non" p1 ent1 "")
; (command "._break" (list ent1 p1) end1)
; (command "._break" (list ent1 p2) end2)
; (command "._pasteclip" "_non" p1)
; (command "._copybase" "_non" p2 ent1 "")
; (entdel ent1)
; (command "._pasteclip" "_non" pause)
; (command "._undo" "_end")
; )
;(prompt "\nCopy Pline section Loaded, Enter PlineClip to run.")
;(princ)
; (progn ;; other suggestion..
; (command "._copybase" "_non" p1 ent1 "")
; (command "._break" (list ent1 p1) end1)
; (command "._break" (list ent1 p2) end2)
; (command "._pasteclip" "_non" p1)
; (command "._move" ent1 "" p2 pause)
; (command "._undo" "_end")
; )
;; Copy a user selected section of an entity http://www.theswamp.org/index.php?topic=10341.0
;; CAB 05/31/06
;; Pick 2 clip points then pick new location for copied entity segment
(defun
c:plc (/ end1 end2 endpt p1 p2 pk1 pk2 strpt)
(princ "\n ** Select: CCW ** ")
(vl-load-com)
(if (and
(setq pk1 (entsel "\n Pick First Polyline Trim Point."))
(setq pk2 (entsel "\n Pick Second Polyline Trim Point."))
(eq (car pk1) (car pk2))
(setq ent1 (car pk1))
(setq p1 (vlax-curve-getClosestPointTo (car pk1) (cadr pk1)))
(setq p2 (vlax-curve-getClosestPointTo (car pk2) (cadr pk2)))
(setq endpt (vlax-curve-getendpoint (car pk1)))
(setq strpt (vlax-curve-getstartpoint (car pk1)))
(if (< (vlax-curve-getDistAtPoint (car pk1) p1)
(vlax-curve-getDistAtPoint (car pk2) p2)
) ;_ end of <
(setq end1 strpt
end2 endpt
) ;_ end of setq
(setq end2 strpt
end1 endpt
) ;_ end of setq
) ;_ end of if
) ;_ end of and
(progn
(command "._copybase" "_non" p1 ent1 "")
;(command "._pasteclip" "_non" p1)
(command "._break" (list ent1 p1) end1)
(command "._break" (list ent1 p2) end2)
(command "._copy" ent1 "" "0,0" "0,0")
(command)
(entdel ent1)
(command)
(command "._move" "L" "" p2 "\\")
(command "._pasteclip" "_non" p1)
(command "._undo" "_end")
) ;_ end of progn
) ;_ end of if
(princ)
) ;_ end of defun