(defun c:Test2 (/ toLine p1 p2 ss lst0 lst1 Pintobj vtx_pline list_vtx_pline)
(if
(and (setq toLine (vlax-ename->vla-object (car (entsel "\nSelect Line: "))))
(setq p1 (getpoint "\nSpecify First Point: "))
(setq p2 (getpoint "\nSpecify Second Point: " p1))
(setq ss (apply 'ssget (append (list "_C") (mapcar '(lambda (foo) (apply 'mapcar (cons foo (list p1 p2)))) '(min max))
(list '((0 . "*LINE"))))))
(setq lst0 ((lambda (l / i) (setq i (lm:getobjintersectionsinss l ss)) (vla-delete l) i)
(vlax-ename->vla-object (entmakex (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2))))))
) ;_and
(progn
;; Find intersection between line and selection
(setq Pintobj (lm:getobjintersectionsinss toLine ss))
;;(princ Pintobj) ;_for testing
(setq cadrm (mapcar 'cadr (ssnamex ss)))
;; Make list (ename point_intersection)
(setq lst1 (mapcar 'list cadrm lst0))
(foreach n lst1
(setq p (fix
(vlax-curve-getparamatpoint
(car n)
(vlax-curve-getclosestpointtoprojection
(car n)
(trans (cadr n) 1 0)
'(0.0 0.0 1.0)
)
)
)
) ;_setq p
(setq vtx_pline (list (trans (vlax-curve-getpointatparam (car n) p) 0 1)))
;;(princ vtx_pline) ;_for testing
(setq list_vtx_pline (append list_vtx_pline vtx_pline)) ;_This is Start point of Selected Segment PLINES as base point of STRETCH:
) ;_foreach
;;(princ list_vtx_pline) ;_for testing
(setq data (mapcar 'list cadrm list_vtx_pline pintobj))
(foreach m data
(vl-cmdf "_.stretch" (car m) "" "_non" (cadr m) (caddr m)))
) ;_progn
) ;_if
(princ)
) ;_defun
(defun lm:getobjintersectionsinss (obj ss)
;; © Lee Mac 2010
((lambda (i / j a b ilst)
(while (setq e (ssname ss (setq i (1+ i))))
(setq ilst (append ilst
(lm:groupbynum
(vlax-invoke
obj
'intersectwith
(vlax-ename->vla-object e)
acextendnone
)
3
)
)
)
)
)
-1
)
)
;; Author: Lee Mac, Copyright © 2010 - www.lee-mac.com ;;
(defun LM:GroupByNum (l n / r)
(if l
(cons
(reverse (repeat n
(setq r (cons (car l) r)
l (cdr l)
)
r
)
)
(LM:GroupByNum l n)
)
)
)
(defun c:stretch-vert-curve
HTH.
M.R.
(defun c:stretch-vert-curve
HTH.
M.R.
Thanks for sharing. It only seems to work with a single crossing box, multiple selections or the crossing lasso seems to fox the routine.
This is working with AutoCAD LT 2024.
I think it should be fine now and with lasso selection... Thanks for feedback...
I think it should be fine now and with lasso selection... Thanks for feedback...
Thanks for looking at the routine. It works perfectly with a crossing window, but the lasso crossing still seems to muck up the polylines when the line is to the left of the selected alignment line. It works fine with selecting polylines to the right of the alignment line.
I presume it's a limitation of how AutoCAD works out the crossing area with the lasso.
A small characteristic is that pressing Ctrl-Z will undo the action plus one more - i.e. if the last item I did was draw a line before starting stretch-vert-curve, pressing undo would delete the line.