Move lines, aligning the edges.

[teknomatika]

Dear masters Autolisp:

We needed to help me. I need a routine that allows to move a selection of lines, making align its edges with a specific alignment base. It will be similar to the function extends / fence, but only with the result of moving.The length of the lines to move should not be changed.

There should be an option to align a given alignment to left, right, top and bottom.

It will be more versatile if the angle of alignment base can be selected but for now just to me that the movement is perpendicular to an alignment.

I enclose a picture to better understand what is intended.

 

[Lee Mac]

Start here.

[pBe]

Start here.

 

I was writing a pseudo code for the OP, apparently he knows how to write codes. but i guess the link you posted probably be more helpful.

 

Cheers Lee

[BlackBox]

[YodaVoice]

 

... A disturbance in the force, I sense.

 

A new "Dynamic Entity Alignment" function, on lee-mac.com must we create.

 

[/YodaVoice]

 

 

linky

[teknomatika]

My knowledge of AutoLISP, are basic. Thank you for the link, I already knew.

Without your help just two years from now will be able to develop.

[alanjt]

I swear I did this for someone on here about 1-2 years ago.

[ghostware]

By: Alan J. Thompson

 

(defun c:MLTC2 (/ ss obj int)
 ;; Move Lines to Curve
 ;; Required Subroutines: AT:GetSel
 ;; Alan J. Thompson, 03.16.10 / 08.02.10
 (vl-load-com)
 (if (and (princ "\nSelect line object(s) to move: ")
          (setq ss (ssget "_:L" '((0 . "LINE,LWPOLYLINE"))))
          (AT:GetSel entsel
                     "\nSelect curve to move line(s) to: "
                     (lambda (x)
                       (if (wcmatch (cdr (assoc 0 (entget (car x)))) "ARC,LINE,*POLYLINE,SPLINE")
                         (setq obj (vlax-ename->vla-object (car x)))
                       )
                     )
          )
     )
   ((lambda (id)
      (vlax-for x (setq
                    ss (vla-get-activeselectionset
                         (cond (*AcadDoc*)
                               ((setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
                         )
                       )
                  )
        (if (and (/= id (vla-get-objectid x))
                 (eq 3 (length (setq int (vlax-invoke x 'IntersectWith obj acExtendThisEntity))))
            )
          (vl-catch-all-apply
            (function vla-move)
            (list x
                  (vlax-3d-point
                    (car (vl-sort (list (vlax-curve-getStartPoint x) (vlax-curve-getEndPoint x))
                                  (function (lambda (a b) (< (distance a int) (distance b int))))
                         )
                    )
                  )
                  (vlax-3d-point int)
            )
          )
        )
      )
      (vla-delete ss)
    )
     (vla-get-objectid obj)
   )
 )
 (princ)
)
(defun AT:GetSel (meth msg fnc / ent good)
 ;; meth - selection method (entsel, nentsel, nentselp)
 ;; msg - message to display (nil for default)
 ;; fnc - optional function to apply to selected object
 ;; Ex: (AT:GetSel entsel "\nSelect arc: " (lambda (x) (eq (cdr (assoc 0 (entget (car x)))) "ARC")))
 ;; Alan J. Thompson, 05.25.10
 (setvar 'errno 0)
 (while (not good)
   (setq ent (meth (cond (msg)
                         ("\nSelect object: ")
                   )
             )
   )
   (cond
     ((vl-consp ent)
      (setq good (if (or (not fnc) (fnc ent))
                   ent
                   (prompt "\nInvalid object!")
                 )
      )
     )
     ((eq (type ent) 'STR) (setq good ent))
     ((setq good (eq 52 (getvar 'errno))) nil)
     ((eq 7 (getvar 'errno)) (setq good (prompt "\nMissed, try again.")))
   )
 )
)

[alanjt]

Slight tweak... (if you found where I posted it, you should post links, not code)

 

(defun c:MCTC (/ _1st AT:GetSel ss obj int)

 (vl-load-com)

 (defun _1st (lst)
   (if lst
     (list (car lst) (cadr lst) (caddr lst))
   )
 )

 (defun AT:GetSel (meth msg fnc / ent)
   ;; meth - selection method (entsel, nentsel, nentselp)
   ;; msg - message to display (nil for default)
   ;; fnc - optional function to apply to selected object
   ;; Ex: (AT:GetSel entsel "\nSelect arc: " (lambda (x) (eq (cdr (assoc 0 (entget (car x)))) "ARC")))
   ;; Alan J. Thompson, 05.25.10
   (setvar 'ERRNO 0)
   (while
     (progn (setq ent (meth (cond (msg)
                                  ("\nSelect object: ")
                            )
                      )
            )
            (cond ((eq (getvar 'ERRNO) 7) (princ "\nMissed, try again."))
                  ((eq (type (car ent)) 'ENAME)
                   (if (and fnc (not (fnc ent)))
                     (princ "\nInvalid object!")
                   )
                  )
            )
     )
   )
   ent
 )

 (princ "\nSelect curve object(s) to move: ")
 (if (and (setq ss (ssget "_:L" '((0 . "LINE,LWPOLYLINE"))))
          (AT:GetSel entsel
                     "\nSelect curve to move selected curve(s) to: "
                     (lambda (x)
                       (if (wcmatch (cdr (assoc 0 (entget (car x)))) "ARC,LINE,*POLYLINE,SPLINE")
                         (setq obj (vlax-ename->vla-object (car x)))
                       )
                     )
          )
     )
   ((lambda (id)
      (vlax-for x (setq ss (vla-get-activeselectionset
                             (cond (*AcadDoc*)
                                   ((setq *AcadDoc* (vla-get-activedocument
                                                      (vlax-get-acad-object)
                                                    )
                                    )
                                   )
                             )
                           )
                  )
        (if (and (/= (vla-get-objectid x) id)
                 (setq int (_1st (vlax-invoke x 'IntersectWith obj acExtendThisEntity)))
            )
          (vla-move x
                    (vlax-3d-point
                      (car (vl-sort (list (vlax-curve-getStartPoint x) (vlax-curve-getEndPoint x))
                                    (function (lambda (a b) (< (distance a int) (distance b int))))
                           )
                      )
                    )
                    (vlax-3d-point int)
          )
        )
      )
      (vla-delete ss)
    )
     (vla-get-objectid obj)
   )
 )
 (princ)
)

[Lee Mac]

This was quite interesting to write:

 

;; Example program by Lee Mac 2011  -  www.lee-mac.com

(defun c:MoveLines2Line ( / en in ip p1 p2 p3 p4 ss )
   (if
       (and
           (princ "\nSelect Line to Move Lines to...")
           (setq en (ssget "_+.:E:S" '((0 . "LINE"))))
           (princ "\nSelect Lines to Move...")
           (setq ss (ssget "_:L" '((0 . "LINE"))))
       )
       (progn
           (setq en (entget (ssname en 0))
                 p1 (cdr (assoc 10 en))
                 p2 (cdr (assoc 11 en))
           )
           (repeat (setq in (sslength ss))
               (setq en (entget (ssname ss (setq in (1- in))))
                     p3 (cdr (assoc 10 en))
                     p4 (cdr (assoc 11 en))
               )
               (if (setq ip (inters p1 p2 p3 p4 nil))
                   (entmod
                       (cons (assoc -1 en)
                           (if (< (distance ip p4) (distance ip p3))
                               (list
                                   (cons 11 ip)
                                   (cons 10 (mapcar '+ ip (mapcar '- p3 p4)))
                               )
                               (list
                                   (cons 10 ip)
                                   (cons 11 (mapcar '+ ip (mapcar '- p4 p3)))
                               )
                           )
                       )
                   )
               )
           )
       )
   )
   (princ)
)

[pBe]

My mediocre attempt:

 

(defun c:LinesTo ( / M o v e to edge)
(defun _errorMsg  (lst / NilVal)
      (while (eval (setq NilVal (car (car lst))))
            (setq lst (cdr lst)))
      (if lst
            (alert (cadr (assoc NilVal lst))))
      )
(prompt "\nSelect objects to move: ")
     (cond ((and
     (setq M (ssget ":L" '((0 . "LINE"))))
     (setq o (car (entsel "\nSelect Edge: ")))
     (setq o (vlax-ename->vla-object o))
     (repeat (sslength M)
           (setq v (ssname M 0))
 (setq edge (mapcar 'cdr (vl-remove-if-not '(lambda (y)
                               (member (car y) '(10 11))) (entget v))))
            (setq e (vlax-invoke (vlax-ename->vla-object v) 'IntersectWith  o acExtendThisEntity))
            (if e (progn
                (if (> (distance e (cadr edge))
                       (distance e (car edge)))
                     (setq to (car edge))
                 (setq to (cadr edge))
                    )
             (vla-move (vlax-ename->vla-object v)
                      (vlax-3d-point to)(vlax-3d-point e))
                       )
                   (progn
                   (princ "\rNo Intersection Found for ")(prin1 ent) ))
            (ssdel v M))
       )
            )
           )
     (_errorMsg
      (list '(m "Failed to select Object")
            '(o "Edge Not Found")
                       ))
(princ)
     )

[teknomatika]

I appreciate the help.

The routines of alanjit and pBe, work well. Corresponds to what I needed.

The Lee Mac routine is not working well. I can not understand why. Have problems in the selection of lines and the routine is interrupted. To select a line, i need to pick twice.

Tanks.

[Lee Mac]

The Lee Mac routine is not working well. I can not understand why. Have problems in the selection of lines and the routine is interrupted. To select a line, i need to pick twice.

 

All is working well for me, moving lines at any angle:

 

[teknomatika]

Lee Mac,

You're right. The problem was the order of selection. It was the first select lines to move.

Thanks for the help.