cg-Cad

Lisp »Tips 'n Tricks »GLUE.LSP

Draws a single line between the two most-distant points of two user-selected lines. Erases the two user-selected lines. Assigns to the new line the same properties of Layer, Color, Linetype, and Thickness as those of the first user-selected line.

Written 02/19/1989 Brad Zehring Autodesk, Inc. Training Department

(defun C:GLUE (/ l1 l2 e1 e2 dl ml temp p pt1 pt2
                 old_flatland old_cmdecho)
  (setq old_flatland (getvar "flatland"))
  (setq old_cmdecho (getvar "cmdecho"))
  (setvar "flatland" 0)
  (setvar "cmdecho" 0)
  (setq l1 (entsel "\nSelect first line: "))
  (setq l2 (entsel "\nSelect second line: "))
  (if
    (or (eq l1 nil) (eq l2 nil))
    (prompt "\nRequires two lines. *Invalid*")
    (progn
      (if
        (not
          (and
            (eq "LINE" (cdr 
             (assoc 0 (setq e1 (entget (car l1)))))
            )
            (eq "LINE" (cdr 
             (assoc 0 (setq e2 (entget (car l2)))))
            )
          )
        )
        (prompt "\nRequires two lines. *Invalid*")
        (progn
          (setq dl nil)
          (setq dl
            (cons
              (list (distance 
                (cdr (assoc 10 e1)) 
                (cdr (assoc 10 e2))
              ) 11)
              dl
            )
          )
          (setq dl
            (cons
              (list (distance 
                (cdr (assoc 10 e1)) 
                (cdr (assoc 11 e2))
              ) 12)
              dl
            )
          )
          (setq dl
            (cons
              (list (distance 
                (cdr (assoc 11 e1)) 
                (cdr (assoc 10 e2))
              ) 21)
              dl
            )
          )
          (setq dl
            (cons
              (list (distance 
                (cdr (assoc 11 e1)) 
                (cdr (assoc 11 e2))
              ) 22)
              dl
            )
          )
          (setq ml nil temp dl)
          (repeat 4
            (setq ml (cons (car (car temp)) ml))
            (setq temp (cdr temp))
          )
          (setq p 
            (car 
              (cdr (assoc 
                (eval (cons 'MAX ml)) dl)
              )
            )
          )
          (cond
            ((= p 11)
             (setq pt1 (cdr (assoc 10 e1)))
             (setq pt2 (cdr (assoc 10 e2)))
            )
            ((= p 12)
             (setq pt1 (cdr (assoc 10 e1)))
             (setq pt2 (cdr (assoc 11 e2)))
            )
            ((= p 21)
             (setq pt1 (cdr (assoc 11 e1)))
             (setq pt2 (cdr (assoc 10 e2)))
            )
            ((= p 22)
             (setq pt1 (cdr (assoc 11 e1)))
             (setq pt2 (cdr (assoc 11 e2)))
            )
            (t)
          )
          (command ".line" pt1 pt2 "")
          (command ".chprop" (entlast) ""
            "LA" (cdr (assoc 8 e1))
            "C"  (if
                   (null (cdr (assoc 62 e1)))
                    ""
                   (cdr (assoc 62 e1))
                 )
            "LT" (if
                   (null (cdr (assoc 6 e1)))
                    ""
                   (cdr (assoc 6 e1))
                 )
            "T"  (if
                   (null (cdr (assoc 39 e1)))
                    ""
                   (cdr (assoc 39 e1))
                 )
                   ""
          )
          (command ".erase" l1 l2 "")
        )
      )
    )
  )
  (setvar "flatland" old_flatland)
  (setvar "cmdecho" old_cmdecho)
  (prin1)
)

Lisp »Tips 'n Tricks