home *** CD-ROM | disk | FTP | other *** search
/ Black Box 4 / BlackBox.cdr / autocad / aug91.arj / TIP682.LSP < prev    next >
Lisp/Scheme  |  1991-09-26  |  2KB  |  71 lines
  1. ;TIP682.LSP   More BOM Bubble   (c)1991, Vitold Serafin
  2.  
  3. (defun C:BALLOON (/ R L C N X1 Y1 X3 Y3 M
  4.   B A BE CE DEL X21 X22 Y21 Y22 Y2 X2 SS
  5.   A1 A2 A3 CIRAD TXTHT ATTHT)
  6.   (setvar "CMDECHO" 0)
  7.   (setvar "ATTDIA" 0)
  8.   ;hard-wired variables
  9.   (setq CIRAD 0.2 ;circle radius
  10.         TXTHT 0.18 ;text height
  11.         ATTHT 0.125 ;attribute height
  12.   )
  13.   (setvar "DIMASZ" TXTHT)
  14.   ;program variables
  15.   (setq L (getpoint "\nLeader start: ")
  16.         C (getpoint "\nBalloon center: ")
  17.         N (getint "\nItem number: ")
  18.         X1 (car C)
  19.         Y1 (cadr C)
  20.         X3 (car L)
  21.         Y3 (cadr L)
  22.   )
  23.   (if (= X1 X3)
  24.     (setq X3 (+ 0.001 X3));no divide by 0
  25.   )
  26.   (setq M (/ (- Y1 Y3) (- X1 X3))
  27.         B (- Y1 (* X1 (/ (- Y1 Y3)
  28.           (- X1 X3))))
  29.         A (+ 1 (* M M))
  30.         BE (* 2 (-(* M(- B Y1)) X1))
  31.         CE (+(-(* X1 X1)(* CIRAD CIRAD))
  32.            (* (- B Y1)(- B Y1)))
  33.         DEL (sqrt(- (* BE BE)(* A CE 4)))
  34.         X21 (/ (+ (- 0 BE) DEL)(* 2 A))
  35.         X22 (/ (- (- 0 BE) DEL)(* 2 A))
  36.         Y21 (+ (* M X21) B)
  37.         Y22 (+ (* M X22) B))
  38.   (if (< (distance L (list X21 Y21))
  39.       (distance L (list X22 Y22)))
  40.     (setq X2 X21)
  41.     (setq X2 X22)
  42.   )
  43.   (setq Y2 (+ (* M X2) B))
  44.   (command "LAYER" "M" "DIM" ^C)
  45.   (command "DIM" "LEADER" L (list X2 Y2)
  46.     ^C ^C)
  47.   (setq SS (ssadd)) (ssadd (entlast) SS)
  48.   (command "LAYER" "M" "C" ^C)
  49.   (command "TEXT" "M" C TXTHT 0 N)
  50.   (ssadd (ssname (ssget L) 0) SS)
  51.   (ssadd (entlast) SS)
  52.   (command "LAYER" "M" "W" ^C)
  53.   (command "CIRCLE" C CIRAD)
  54.   (ssadd (entlast) SS)
  55.   (setq A1 (list (- X1 0.042)(+ Y1 0.25))
  56.         A2 (list (+ X1 0.167)(+ Y1 0.25))
  57.         A3 (list (- X1 0.042)(+ Y1 1.31))
  58.   )
  59.   (command "ATTDEF" "" "PN" "PART NUMBER"
  60.     "" A1 ATTHT 90)
  61.   (ssadd (entlast) SS)
  62.   (command "ATTDEF" "" "DS" "DESCRIPTION"
  63.     "" A2 "" "")
  64.   (ssadd (entlast) SS)
  65.   (command "ATTDEF" "" "QT" "QTY." "1" A3
  66.     "" "")
  67.   (ssadd (entlast) SS)
  68.   (command "BLOCK" (itoa N) C SS "")
  69.   (command "INSERT" (itoa N) C "" "" "")
  70. )
  71.