home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / CLIPPER / MISC / LCK21B.ZIP / OSNAP.LSP < prev    next >
Encoding:
Text File  |  1988-11-18  |  3.4 KB  |  81 lines
  1. ; Stan H. Bimson 73507,3475 - CAD/Engineering Services - 15 June 1987
  2. ; Rte 2 Box 293 Forest Harbor Drive  -  Hendersonville, TN 37075-9802
  3. ;
  4. ;                 Requires AutoCAD V2.5+ ADE3
  5. ; Object snap commands are great but they have some limitations,
  6. ; you can not snap to something that is not there!! Well we are
  7. ; going to modify two of the standard commands Intersection and
  8. ; Midpoint and add one called Extend.
  9. ;
  10. ; These are not really OSNAP commands inasmuch as their function
  11. ; names can be typed while in a command but they can be CALLED,
  12. ; AutoLISP can be engaged at almost anytime (except while IN an
  13. ; AutoLISP function). While in a LINE command just type (intx)
  14. ; from the keyboard or pick the command off the screen menu. You
  15. ; should have your menu where you can get to the OSNAP menu at
  16. ; anytime while in any command.
  17. ;
  18. ; INTX.LSP - snap to the intersection of any two lines but the
  19. ; two lines do not have to intersection themselves. First code
  20. ; written by Tony Tanzillo, A/E Automation Systems 70307,2556
  21.  
  22. (DeFun IntX (/ L0)            ; Syntax:   (INTX)
  23.   (Inters
  24.     (Car (SetQ L0 (Endpts (EntSel "\nIntersection of line") '(10 11))))
  25.     (Cadr L0)
  26.     (Car (SetQ L0 (Endpts (EntSel " and line ") '(10 11))))
  27.     (Cadr L0)
  28.     Nil)
  29. ); end intx.lsp
  30.  
  31. ; MIDX.LSP - snap to the midpoint of any two points.
  32.  
  33. (DeFun MidX (/ P0 P1)         ; Syntax:   (MIDX)
  34.   (SetQ P0 (GetPoint "\nLocate 1st point "))
  35.   (SetQ P1 (GetPoint P0 "\nLocate 2st point "))
  36.   (MapCar '(LamBDA (x1 x2) (/ (+ x1 x2) 2)) P0 P1)
  37. ); end midx.lsp
  38.  
  39. ; EXTX.LSP - now this is a "second" or "to" function, some command
  40. ; has to have been stated and a "first" point done such as:
  41. ;             LINE 15.25,5.75 (extx)
  42. ; where we start a line from point 15.25,5.75 and we call EXTX to
  43. ; goto the second point. We are first asked to show which direction
  44. ; that we want to go, then we are asked for a line to extend to,
  45. ; unlike the EXTEND command, the line we pick does not have to really
  46. ; cross the new line we are drawing. At this time we also have the
  47. ; option of showing a line that we would want to extend to by entering
  48. ; any two points to define a line (which is not there). First code
  49. ; written by Tony Tanzillo, A/E Automation Systems 70307,2556
  50.  
  51. (DeFun ExtX (/ P0 P1 E0 P2 L0); Syntax:   (EXTX)
  52.   (SetQ P0 (GetVar "lastpoint"))
  53.   (SetQ P1 (GetPoint P0 "\nShow angle : "))
  54.   (SetQ E0 (EntSel "\nLine to extend to, or ENTER for 2 points: "))
  55.   (SetQ L0
  56.     (If E0 (EndPts E0 '(10 11)) ; Then
  57.            (ProgN               ; Else
  58.              (List
  59.                (SetQ P2 (GetPoint "\nFrom point : "))
  60.                (GetPoint P2 " to point : ")) ); end else ProgN
  61.     ); endIf
  62.   ); end SetQ
  63.   (If (And P0 P1 (Car L0) (Cdr L0))
  64.     (Apply 'Inters (List P0 P1 (Car L0) (Cadr L0) Nil)) )
  65. ); end ext.lsp
  66.  
  67. ; get the endpoints of a LINE entity, first code written
  68. ; by Tony Tanzillo, A/E Automation Systems 70307,2556
  69.  
  70. (DeFun EndPts(Ex Px)          ; Syntax:   (ENDPTS <entity name> <atom list>)
  71.   (Cond
  72.     ( (Atom Px)
  73.       (Cdr (Assoc Px (EntGet (Cond ((Eq (Type Ex) 'ENAME) Ex) ((Car Ex)))))))
  74.     ( T (MapCar '(LamBDA(x) (EndPts Ex x )) Px)) )
  75. ); end endpts
  76.  
  77. ; I have used these functions while in AutoCAD commands LINE, MOVE, COPY,
  78. ; STRETCH, ROTATE. I can see using them in BREAK, CIRCLE, ARC, MIRROR,
  79. ; and ARRAY. These functions do not work in TRIM or EXTEND as they require
  80. ; entities not point values.
  81.