home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 15 / CD_ASCQ_15_070894.iso / vrac / may94cad.zip / TIP984.LSP < prev    next >
Lisp/Scheme  |  1994-04-25  |  7KB  |  179 lines
  1. ; TIP984.LSP: FIX.LSP   Clean Up Wall Intersections   (c)1994, Steven Hauk
  2.  
  3. (defun C:FIXC (/ PT1 PT2 PT3 PT4 PT5 PT6 PT7 PT0 DST1 DST2)
  4.         (setq PB1 (getvar "pickbox"))
  5.         (setvar "cmdecho" 0)
  6.         (setvar "osmode" 32)
  7.         (setvar "pickbox" 1)
  8.                 (setq PT2  (getpoint "\nSelect first intersection <ccw>:  "))
  9.                 (setq PT1  (getpoint "\nSelect second intersection <ccw>: "))
  10.         (setvar "osmode"  0)
  11.                 (setq DST1 (distance PT1 PT2))
  12.                 (setq DST2 (* DST1 0.5))
  13.                 (setq ANG1 (angle PT2 PT1))
  14.                 (setq ANG2 (+ (/ pi 2) ANG1))
  15.                 (setq PT3  (polar PT2 ANG1 DST2))
  16.                 (setq PT4  (polar PT2 ANG2 DST2))
  17.                 (setq PT5  (polar PT4 ANG2 DST2))
  18.                 (setq PT6  (polar PT5 ANG1 DST2))
  19.                 (setq PT7  (polar PT1 ANG2 DST2))
  20.         (command "trim" "c" PT1 PT5 "" PT6 PT7 PT4 PT3 "")
  21.         (setvar "pickbox" PB1)
  22.         (princ DST1)
  23.         (princ)
  24. )
  25.  
  26. (defun C:FIXR (/ PT1 PT2 PT3 PT4 PT5 PT6 PT7 PT8 DST1 DST2)
  27.         (setq PB1 (getvar "pickbox"))
  28.         (setvar "cmdecho" 0)
  29.         (setvar "osmode" 32)
  30.         (setvar "pickbox" 1)
  31.                 (setq PT1  (getpoint "\nSelect first intersection <ccw>:  "))
  32.                 (setq PT2  (getpoint "\nSelect second intersection <ccw>: "))
  33.         (setvar "osmode"  0)
  34.                 (setq DST1 (distance PT1 PT2))
  35.                 (setq DST2 (* DST1 0.5))
  36.                 (setq ANG1 (angle PT1 PT2))
  37.                 (setq ANG2 (+ (/ pi 2) ANG1))
  38.                 (setq PT3  (polar PT2 ANG1 DST2))
  39.                 (setq PT4  (polar PT3 ANG2 DST1))
  40.                 (setq PT5  (polar PT2 ANG2 DST1))
  41.                 (setq PT6  (polar PT1 ANG2 DST2))
  42.                 (setq PT7  (polar PT6 ANG2 DST1))
  43.                 (setq PT8  (polar PT1 ANG1 DST2))
  44.                 (setq PT9  (polar PT5 ANG2 DST2))
  45.         (command "trim" "c" PT1 PT5 "" PT3 PT4 PT9 PT7 PT6 PT8 "")
  46.         (setvar "pickbox" PB1)
  47.         (princ DST1)
  48.         (princ)
  49. )
  50.  
  51. (defun C:FIXT (/ PT1 PT2 PT3 PT4 PT5 PT6 PT7 PT0 DST1 DST2)
  52.         (setq PB1 (getvar "pickbox"))
  53.         (setvar "cmdecho" 0)
  54.         (setvar "osmode" 32)
  55.         (setvar "pickbox" 1)
  56.                 (setq PT2  (getpoint "\nSelect first intersection <ccw>:  "))
  57.                 (setq PT1  (getpoint "\nSelect second intersection <ccw>: "))
  58.         (setvar "osmode"  0)
  59.                 (setq DST1 (distance PT1 PT2))
  60.                 (setq DST2 (* DST1 0.5))
  61.                 (setq ANG1 (angle PT2 PT1))
  62.                 (setq ANG2 (+ (/ pi 2) ANG1))
  63.                 (setq PT3  (polar PT2 ANG1 DST2))
  64.                 (setq PT4  (polar PT2 ANG2 DST2))
  65.                 (setq PT5  (polar PT4 ANG2 DST1))
  66.                 (setq PT6  (polar PT5 ANG1 DST1))
  67.                 (setq PT7  (polar PT1 ANG2 DST2))
  68.         (command "trim" "c" PT1 PT5 "" PT6 PT5 PT7 PT4 PT3 "")
  69.  
  70.         (setvar "pickbox" PB1)
  71.         (princ DST1)
  72.         (princ)
  73. )
  74.  
  75. (defun FIXT2 (/ OS1 PT1 PT2 PT3 PT4 PT5 PT6 PT7 PT8 PT9 
  76.                         DST1 DST1A DST2 DST2A)
  77.         (setq   PB1 (getvar "pickbox")        
  78.                 OS1 (getvar "osmode"))
  79.         (setvar "cmdecho" 0)
  80.         (setvar "pickbox" 1)
  81.         (setvar "osmode" 32)
  82.         (prompt "\nFirst two points determine inside corners to remain.")
  83.                 (setq PT1  (getpoint "\nSelect first intersection <ccw>:  "))
  84.                 (setq PT2  (getpoint "\nSelect second intersection <ccw>: "))
  85.                 (setq PT3  (getpoint "\nSelect third intersection <ccw>: "))
  86.         (setvar "osmode"  0)
  87.                 (setq DST1  (distance PT1 PT2)
  88.                       DST1A (distance PT2 PT3)
  89.                       DST2  (* DST1 0.5)
  90.                       DST2A (* DST1A 0.5)
  91.                       ANG1  (angle PT1 PT2)
  92.                       ANG2  (angle PT2 PT3)
  93.                       PT4   (polar PT1 ANG1 DST2)
  94.                       PT5   (polar PT2 ANG2 DST2A) 
  95.                       PT7   (polar PT5 ANG2 DST1A) 
  96.                       PT8   (polar PT1 ANG2 DST2A) 
  97.                       PT9   (polar PT8 ANG2 DST1A))
  98.         (command "trim" "c" PT1 PT3 "" PT9 PT7 PT8 PT5 PT4 "")
  99.         (setvar "pickbox" PB1) 
  100.         (setvar "osmode" OS1)
  101. )
  102.  
  103. (defun FIXR2 (/ OS1 PB1 PT1 PT2 PT3 PT4 PT5 PT6 PT7 
  104.                 DST1A DST1 DST2 DST2A DST3 DST3A)
  105.         (setq PB1 (getvar "pickbox")        
  106.               OS1 (getvar "osmode"))
  107.         (setvar "cmdecho" 0)
  108.         (setvar "pickbox" 1)
  109.         (setvar "osmode" 32)
  110.         (prompt "\nFirst point determines inside corner to remain.")
  111.                 (setq PT1  (getpoint "\nSelect first intersection <ccw>:  "))
  112.                 (setq PT2  (getpoint "\nSelect second intersection <ccw>: "))
  113.                 (setq PT3  (getpoint "\nSelect third intersection <ccw>: "))
  114.         (setvar "osmode"  0)
  115.                 (setq DST1  (distance PT1 PT2)
  116.                       DST1A (distance PT2 PT3)
  117.                       DST2  (* DST1 0.5)
  118.                       DST2A (* DST1A 0.5)
  119.                       DST3  (* DST1 1.5)
  120.                       DST3A (* DST1A 1.5)
  121.                       ANG1  (angle PT1 PT2)
  122.                       ANG2  (angle PT2 PT3)
  123.                       PT4   (polar PT1 ANG2 DST2A)
  124.                       PT5   (polar PT1 ANG1 DST2) 
  125.                       PT6   (polar PT1 ANG1 DST3) 
  126.                       PT7   (polar PT1 ANG2 DST3A) 
  127.                       PT8   (polar PT2 ANG2 DST3A) 
  128.                       PT9   (polar PT3 ANG1 DST2))
  129.         (command "trim" "c" PT1 PT3 "" PT6 PT9 PT8 PT7 PT4 PT5 "")
  130.         (setvar "pickbox" PB1) 
  131.         (setvar "osmode" OS1)
  132. )
  133.  
  134. (defun FIXC2 (/ PB1 OS1 PT1 PT2 PT3 PT4 PT5 PT6 PT7 
  135.                 DST1 DST1A DST2 DST2A)
  136.         (setq PB1 (getvar "pickbox"))
  137.         (setq OS1 (getvar "osmode")) 
  138.         (setvar "pickbox" 1)
  139.         (setvar "cmdecho" 0)
  140.         (setvar "osmode" 32)
  141.                 (setq PT1  (getpoint "\nSelect first intersection <ccw>:  "))
  142.                 (setq PT2  (getpoint "\nSelect second intersection <ccw>: "))
  143.                 (setq PT3  (getpoint "\nSelect third intersection <ccw>: "))
  144.         (setvar "osmode"  0)
  145.                 (setq DST1  (distance PT1 PT2) 
  146.                       DST1A (distance PT2 PT3)
  147.                       DST2  (* DST1 0.5) 
  148.                       DST2A (* DST1A 0.5)
  149.                       ANG1  (angle PT1 PT2) 
  150.                       ANG2  (angle PT2 PT3) 
  151.                       PT4   (polar PT1 ANG1 DST2) 
  152.                       PT5   (polar PT2 ANG2 DST2A) 
  153.                       PT6   (polar PT1 ANG2 DST2A) 
  154.                       PT7   (polar PT1 ANG2 DST1A) 
  155.                       PT8   (polar PT7 ANG1 DST2))
  156.         (command "trim" "c" PT1 PT3 "" PT4 PT5 PT6 PT8 "")
  157.         (setvar "pickbox" PB1)
  158.         (setvar "osmode" OS1)
  159. )
  160.  
  161. (defun C:FIX (/ FIX1)
  162.         (if (not  *FIX1)
  163.             (setq *FIX1 "C"))
  164.  (setq FIX1 (strcase (getstring "\nIntersection type = Tee/Cross/corneR: ")))
  165.         (if (equal FIX1 "")
  166.              (setq FIX1 *FIX1)(setq *FIX1 FIX1))
  167.  (princ "Option chosen...")
  168.  (princ FIX1)
  169.         (if (equal FIX1 "T") 
  170.                   (FIXT2))         
  171.         (if (equal FIX1 "C") 
  172.                   (FIXC2))
  173.         (if (equal FIX1 "R") 
  174.                   (FIXR2))
  175.  
  176. )
  177.  
  178.  
  179.