Topic: Extend/Trim set of lines to a line

[sinc]

Some time back, I think someone posted a Lisp routine for extending/trimming a selection set of lines to a line, but I can't seem to find it.  Anyone got something that does that?  I'm pressed for time, and don't want to write one myself.

[Dommy2Hotty]

Extend

Code: [Select]

(defun C:EXTMULT (/ ss pt ls no edges)
;(f:modes)
        (prompt "\nSelect line to extend to..")
(setq edges (ssget))
(prompt "\nSelect object(s) to extend: ")
(setq ss (ssget)
pt (getpoint "\nSelect line to extend to: ")
ls (sslength ss)
no -1)
(command "extend" edges "")
(repeat ls
(setq no (1+ no))
(command (list (ssname ss no) pt))
)
(command "")
(princ)
)

Trim

Code: [Select]

(defun C:TRIMMULT (/ ss pt ls no edges)
;(f:modes)
(prompt "\nSelect cutting edges..")
(setq edges (ssget))
(prompt "\nSelect object(s) to trim: ")
(setq ss (ssget)
pt (getpoint "\nSide to trim: ")
ls (sslength ss)
no -1)
(command "trim" edges "")
(repeat ls
(setq no (1+ no))
(command (list (ssname ss no) pt))
)
(command "")
(princ)
)

[CADaver]

Some time back, I think someone posted a Lisp routine for extending/trimming a selection set of lines to a line, but I can't seem to find it.  Anyone got something that does that?  I'm pressed for time, and don't want to write one myself.

ummm... FENCE???

[CAB]

Sinc, where have you been?
Here is another:

Code: [Select]

(defun C:TRM (/ pt1 usrecho useros ss)
  (setq usrecho (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (setq useros (getvar "osmode"))
  (setvar "osmode" 0)
  (while
    (progn
      (prompt "\nSelect cutting edges: ")
      (if (setq ss (ssget))
        (progn
          (command "undo" "begin")
          (setq pt1 (getpoint "\nDraw line to select items to be trimmed: ") )
          (cond
            ((/= pt1 nil)
             (not(command "_.trim" ss "" "F" pt1 pause "" ""))
            )
            (T nil)
          )
        )
      )
    )
  )
  (command "undo" "end")
  (setvar "cmdecho" usrecho)
  (setvar "osmode" useros)
  (princ)
) ; end defun

(princ "\nType TRM to run.")
(princ)

[qjchen]

Just modify this topic to add a gif picture.

From Mr Stig Smadsen's homepage, I find the useful program to combine trim and extend  line in one.
http://intervision.hjem.wanadoo.dk/lisps/touch.lsp
I am not sure whether Mr Stig Smadsen has post here.

Code: [Select]

;;;                                                        *
;;; Touch.LSP                                              *
;;; Small routine to align endpoints of lines to an edge.  *
;;; The edge have to be a line.                            *
;;; The routine works by calculating the point of inter-   *
;;; section and change the nearest endpoint to that point  *
;;; 2001 Stig Madsen, no rights reserved                   *

(defun C:Tt(/ cmd ent entl spt ept sset a lent lentl lspt lept lint)
  (setq cmd (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)
  (command "UNDO" "Begin")
  (while (not ent)
    (setq ent (car (entsel "Select edge line: ")))
    (if ent
      (progn
        (setq entl (entget ent))
        (if (/= (cdr (assoc 0 entl)) "LINE")
          (setq ent nil)
          (setq spt (cdr (assoc 10 entl))
                ept (cdr (assoc 11 entl))
          )
        )
      )
    )
  )
  (if ent
    (progn
      (redraw ent 3)
      (prompt "\nSelect lines to touch edge: ")
      (setq sset (ssget '((0 . "LINE")))
            a    0
      )
      (if sset
        (repeat (sslength sset)
          (setq lentl (entget (setq lent (ssname sset a)))
                lspt  (cdr (assoc 10 lentl))
                lept  (cdr (assoc 11 lentl))
                lint  (inters spt ept lspt lept nil)
          )
         
          (if lint
            (progn

              (if (< (distance lint lspt) (distance lint lept))
                (entmod (subst (cons 10 lint) (assoc 10 lentl) lentl))
                (entmod (subst (cons 11 lint) (assoc 11 lentl) lentl))
              )
            )
          )
          (setq a (1+ a))
        )
        (princ "\nNo objects found")
      )
      (redraw ent 4)
    )
    (princ "\nNo edge selected")
  )
  (setvar "CMDECHO" cmd)
  (command "UNDO" "End")
  (princ)
)

I do a little modification to enlarge the edge type extension, but the extend and trim object still must be lines
I can't write the code to let the extend and trim object also more than lines

Code: [Select]

;;; Touch.LSP                                              *
;;; Small routine to align endpoints of lines to an edge.  *
;;; The edge have to be a line.                            *
;;; The routine works by calculating the point of inter-   *
;;; section and change the nearest endpoint to that point  *
;;; 2001 Stig Madsen, no rights reserved                   *
;;; modified by qjchen, the edge line can be line or polyline *

(defun C:Ttt (/ cmd ent entl spt ept sset a lent lentl lspt lept lint)
  (vl-load-com)
  (setq cmd (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)
  (command "UNDO" "Begin")
  (while (not ent)
    (setq ent (car (entsel "Select edge line: ")))
    (if ent
      (progn
(setq entl (entget ent))
      )
    )
  )
  (if ent
    (progn
      (redraw ent 3)
      (prompt "\nSelect lines to touch edge: ")
      (setq sset (ssget '((0 . "LINE")))
    a 0
      )
      (if sset
(repeat (sslength sset)
  (setq lentl (entget (setq lent (ssname sset a)))
lspt (cdr (assoc 10 lentl))
lept (cdr (assoc 11 lentl))
  )
  (setq entttt (ssname sset a))
  (setq lint (nth 0 (x_intlst ent entttt acExtendOtherEntity)))
  (if lint
    (progn

      (if (< (distance lint lspt) (distance lint lept))
(entmod (subst
  (cons 10 lint)
  (assoc 10 lentl)
  lentl
)
)
(entmod (subst
  (cons 11 lint)
  (assoc 11 lentl)
  lentl
)
)
      )
    )
  )
  (setq a (1+ a))
)
(princ "\nNo objects found")
      )
      (redraw ent 4)
    )
    (princ "\nNo edge selected")
  )
  (setvar "CMDECHO" cmd)
  (command "UNDO" "End")
  (princ)
)

;;; by kuangdao at xdcad
(defun x_intlst (obj1 obj2 param / intlst1 intlst2 ptlst)

  (if (= 'ENAME (type obj1))
    (setq obj1 (vlax-ename->vla-object obj1))
  )
  (if (= 'ENAME (type obj2))
    (setq obj2 (vlax-ename->vla-object obj2))
  )
  (setq intlst1 (vlax-variant-value (vla-intersectwith obj1 obj2 param)))
  (if (< 0 (vlax-safearray-get-u-bound intlst1 1))
    (progn
      (setq intlst2 (vlax-safearray->list intlst1))
      (while (> (length intlst2) 0)
(setq ptlst (cons (list (car intlst2) (cadr intlst2) (caddr intlst2))
  ptlst
    )
      intlst2 (cdddr intlst2)
)
      )
    )
  )
  ptlst
)