1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124

(defun c:mtl ()
  (setq ss (getvar "osmode"))
  (setq cc (getvar "cecolor"))
  (setvar "osmode" 512)

  (prompt "\n先画圆:采用圆心和半径式")
  (setq	pc (getpoint "\n圆心")
	p0 (getpoint pc "\n圆周上点")
  )
  (setq tpc pc)
  (setq r (distance pc p0))
  (setq r2 (/ r 2))

  (command "circle" pc (* 0.875 r))
  (command "circle" pc r2)
  
  (setq tang0 (/ pi 18))
  (setq tang1 (/ pi 9))

  (setq i 1)
  (repeat 36
    
    (setq pt1 (polar pc (* tang0 i) r2))
    (setq pt2 (polar pc (+ (* tang1 (fix (/ i 2))) (/ tang1 4)) r))

    (setq pt3 (polar pc (+ (* tang1 (fix (/ (- i 1) 2))) (/ tang1 4)) r) )
    (setq pt4 (polar pc (+ (* tang1 (fix (/ (+ i 1) 2))) (/ tang1 4)) r) )

    (setq pt5 (polar pc (+ (* tang1 (fix (/ i 2))) (/ tang1 4)) (* 0.875 r) ) )
    (setq pt6 (polar pc (+ (* tang1 (fix (/ (+ i 1) 2))) (/ tang1 4)) (* 0.875 r) ) )
    (command "line" pt5 pt6 "")
    
    
    (command "line" pc pt1 "")
    (command "line" pt1 pt2 "")
    (command "line" pt1 pt3 "")
    (command "line" pt1 pt4 "")
    (command "line" pt2 pt3 "")
    (command "circle" pt2 (/ r2 4))

    (setq i (+ i 1))
  )

  (setq pc (list (+ (nth 0 pc) (* 2 r)) (nth 1 pc)))
  (command "circle" pc (/ r2 4))

  (setq tr r)
  (setq r (* 1.25 r))

  (setq pcd (list (nth 0 pc) (- (nth 1 pc) r)))
  (setq pcl (list (- (nth 0 pcd) r) (nth 1 pcd)))
  (setq pcr (list (+ (nth 0 pcd) r) (nth 1 pcd)))

  (setq pcl1 (list (- (nth 0 pcd) (/ r 2)) (nth 1 pcd)))
  (setq pcr1 (list (+ (nth 0 pcd) (/ r 2)) (nth 1 pcd)))
  (command "line" pc pcl1 "")
  (command "line" pc pcr1 "")

  (command "line" pc pcl "")
  (command "line" pc pcr "")
  (command "line" pc pcd "")
  (command "line" pcr pcl "")

  (setq pclm (polar pcd (* (/ 3.0 4.0) pi) (* r (/ (sqrt 2.0) 2.0))))
  (command "line" pclm pcr "")
  (command "line" pclm pcd "")

  (setq pcrm (polar pcd (/ pi 4) (* r (/ (sqrt 2.0) 2.0))))
  (command "line" pcrm pcl "")
  (command "line" pcrm pcd "")



  (setq r4 (/ r2 2))
  (setq pc (list (nth 0 pc) (- (nth 1 pc) (* 3 tr))))
  (setq pcd (list (nth 0 pc) (- (nth 1 pc) r)))
  (setq plu (list (- (nth 0 pc) r4) (+ (nth 1 pc) tr)))
  (setq pru (list (+ (nth 0 pc) r4) (+ (nth 1 pc) tr)))
  (setq pld (list (- (nth 0 pc) r4) (- (nth 1 pc) tr)))
  (setq prd (list (+ (nth 0 pc) r4) (- (nth 1 pc) tr)))

  (setq pcr (list (+ (nth 0 pc) tr) (- (nth 1 pc) r)))
  (command "pline" plu pru prd pld "c")
  (command "line" plu prd "")
  (command "line" pru pld "")
  (command "line" pc pcd "")
  (command "line" pc pcr "")
  (command "line" pcd pcr "")

    
  (setq pc (list (nth 0 tpc) (- (nth 1 tpc) (* 3 tr))))
  (setq r tr)
  (command "circle" pc tr)
  (command "circle" pc r2)

  
    (setq i 1)
  (repeat 36
    
    (setq pt1 (polar pc (* tang0 i) r2))
    (setq pt2 (polar pc (+ (* tang1 (fix (/ i 2))) (/ tang1 4)) r))

    (setq pt3 (polar pc (+ (* tang1 (fix (/ (- i 4) 2))) (/ tang1 4)) r) )
    (setq pt4 (polar pc (+ (* tang1 (fix (/ (+ i 4) 2))) (/ tang1 4)) r) )

    (setq pt5 (polar pc (+ (* tang1 (fix (/ i 2))) (/ tang1 4)) (* 0.875 r) ) )
    (setq pt6 (polar pc (+ (* tang1 (fix (/ (+ i 1) 2))) (/ tang1 4)) (* 0.875 r) ) )
    (command "line" pt5 pt6 "")
    
    
    (command "line" pc pt1 "")
    (command "line" pt1 pt2 "")
    (command "line" pt1 pt3 "")
    (command "line" pt1 pt4 "")
    (command "line" pt2 pt3 "")
    (command "circle" pt2 (/ r2 4))

    (setq i (+ i 1))
  )

    
  (setvar "osmode" ss)
  (setvar "cecolor" cc)
)