home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / APPS / CAD / PKEY11_1.ZIP / GL.LSP < prev    next >
Encoding:
Text File  |  1992-03-14  |  1.6 KB  |  41 lines
  1. ;Paste lines or arcs together (kinda glitchy but it works and wont nuke
  2. ;anything)
  3. ;                     ********Patrick J. McKee, author********
  4. ;                       ****Copyright 1992, Power Key tm****
  5. ;
  6. (defun c:gl()
  7. (setq oer *error* *error* err2)
  8. (setq e1(car(entsel "\nPick first entity : ")))
  9. (setq e2(car(entsel "\nPick second entity: ")))
  10. (if(equal e1 e2)(err))
  11. (setq et1(cdr(assoc 0(entget e1))))
  12. (if(= et1 "LINE")(ga))
  13. (setq cp1(cdr(assoc 10(entget e1))))
  14. (setq cp3(cdr(assoc 10(entget e2))))
  15. (setq la1(cdr(assoc 8(entget e1))))
  16. (setq asp1(polar cp1(cdr(assoc 50(entget e1)))(cdr(assoc 40(entget e1)))))
  17. (setq asp2(polar cp1(cdr(assoc 51(entget e1)))(cdr(assoc 40(entget e1)))))
  18. (setq asp3(polar cp3(cdr(assoc 50(entget e2)))(cdr(assoc 40(entget e2)))))
  19. (setq asp4(polar cp3(cdr(assoc 51(entget e2)))(cdr(assoc 40(entget e2)))))
  20. (command"erase" e1 e2 "")
  21. (if(<(distance asp1 asp3)(distance asp1 asp4))
  22. (setq ep asp4 mp asp3 d(distance asp1 asp3))
  23. (setq ep asp3 mp asp4 d(distance asp1 asp4)))
  24. (if(<(distance asp2 asp3)(distance asp2 asp4))
  25. (setq ep1 asp4 mp1 asp3 d1(distance asp2 asp3))
  26. (setq ep1 asp3 mp1 asp4 d1(distance asp2 asp4)))
  27. (if(< d d1)
  28. (command "arc" asp2 mp ep)
  29. (command "arc" asp1 mp1 ep1))
  30. (command "change"(entlast)"" "p" "la" la1 "")
  31. (princ))
  32. (defun ga()
  33. (setq pt1(cdr(assoc 10(entget e1))))
  34. (setq pt2(cdr(assoc 11(entget e1))))
  35. (setq pt3(cdr(assoc 10(entget e2))))
  36. (setq pt4(cdr(assoc 11(entget e2))))
  37. (command "erase" e2 "")
  38. (if(>(distance pt1 pt3)(distance pt1 pt4))
  39. (command "change" e1 "" pt3)
  40. (command "change" e1 "" pt4))
  41. (princ))