牛顿分形的LISP程序

牛顿分形简介：
在复数域上使用牛顿迭代生成分形图像，函数公式F(z) = z^3 – 1在复数域上面有三个根，一个是1，另外两个分别是复数-0.5+0.866i 与 -0.5 – 0.866i根据计算出来根的值不同转换为RGB三种不同的颜色，根据迭代次数的多少设置颜色值的大小，即颜色强度。
Newton's Fractal
下面是用LISP代码的实现。

;;;************
;;;牛顿迭代分形
;;;************
(defun C:Nt (/ con eps  OLDCMD oldsnap t0  gg ita)
  (vl-load-com)
  (setq *APP (vlax-get-acad-object))
  (setq	colObj (vla-getinterfaceobject *APP "AutoCAD.AcCmColor.16"))
  (setq OLDCMD (getvar "CMDECHO"))
  (setq oldsnap (getvar "OSMODE"))
  (princ "n请选择三种不同的颜色:")
  (princ "n选择颜色1:n")
  (setq c1 (acad_truecolordlg 1))
  (princ "n选择颜色2:n")
  (setq c2 (acad_truecolordlg 3))
  (princ "n选择颜色3:n")
  (setq c3 (acad_truecolordlg 5))
  (setq gg (getint "n输入颜色梯度:"))
  (setq sol (getint "n输入分辨率:"))
  (setq EPS (getreal "n输入迭代误差:"))     ;迭代误差
  (setq ita (getint "n最大迭代次数:"))
  (if (and c1 c2 c3 gg sol EPS ita)
    (progn   
      (setvar "CMDECHO" 0)
      (setvar "OSMODE" 0)
      (setq t0 (getvar "TDUSRTIMER"))
      (NewTon_fractal sol sol EPS c1 c2 c3 gg ita)
      (princ "n画牛顿分形用时")
      (princ (* (- (getvar "TDUSRTIMER") t0) 86400))
      (princ "秒")
      ;;(command ".ZOOM" '(39 39) '(361 361))
      (command ".ZOOM" "E")
      (setvar "OSMODE" oldsnap)
      (setvar "CMDECHO" OLDCMD)
    )
    (alert "n你没有输入有效选择!")
  )
  (gc)
  (princ)
)
(defun trans-&gt;RGB (color / ccc) 
  (if (setq ccc (cdr (assoc 420 color)))
    (Number-&gt;RGB ccc)
    (Index-&gt;RGB colObj (cdr (assoc 62 color)))
  )
)
(defun NewTon_fractal(solx soly EPS c1 c2 c3 grad ita /
		      col1 col2 col3 hsl1 hsl2 hsl3 con xx yy nx ny
		      cm newx newy x y k)
  (setq col1 (trans-&gt;RGB c1))  
  (setq HSL1 (RGB-&gt;HSL (car col1) (cadr col1) (caddr col1)))
  (setq col2 (trans-&gt;RGB c2))  
  (setq HSL2 (RGB-&gt;HSL (car col2) (cadr col2) (caddr col2)))
  (setq col3 (trans-&gt;RGB c3))  
  (setq HSL3 (RGB-&gt;HSL (car col3) (cadr col3) (caddr col3)))
  (setq CON (/ (sqrt 3.0) 2))
  (setq xx (/ solX 4.0))
  (setq yy (/ solY 4.0))
  (setq nx (/ solx -2))
  (repeat solx
    (setq ny (/ soly -2))
    (repeat soly
      (setq x (/ nx xx))
      (setq y (/ ny yy))
      (setq k 0)
      (while (and (&lt; k ita) (/= (dist x y) 0))
	(setq cm   (* 3 (dist x y) (dist x y))
	      newx (+ (* 2 x (/ 1.0 3)) (/ (- (* x x) (* y y)) cm))
              newy (- (* 2 y (/ 1.0 3)) (/ (* 2 x y) cm))
              x    newx
	      y    newy
	)
	(cond
	  ( (&lt; (dist (1- x) y) EPS)
	    (putcolor hsl1 nx ny k)
	    (setq k ita)
	  )
          ( (&lt; (dist (+ x 0.5) (- y con)) EPS)
            (putcolor hsl2 nx ny k)
	    (setq k ita)
          )
          ( (&lt; (dist (+ x 0.5) (+ y con)) EPS)
	    (putcolor hsl3 nx ny k)
	    (setq k ita)
          )
        )	   
	(setq k (1+ k))
      )
      (setq ny (1+ ny))
    )
    (setq nx (1+ nx))
  )
)
;;距离平方函数
(defun dist (a b)
  (+ (* a a) (* b b))
)
(defun putcolor	(HSL nx ny k / nH ncolor)
  (setq nH (rem (+ (car HSL) (* grad k)) 361))
  (setq ncolor (hsl-&gt;rgb nH (cadr hsl) (caddr hsl)))
  (setq ncolor (rgb-&gt;number ncolor))
  (putpixel nx ny ncolor)
)
;;;==========================
;;;用entmake方法画像素点函数 
;;;==========================
(defun putpixel (a b c)
  (entmake
    (list
      '(0 . "LWPOLYLINE")    
      '(100 . "AcDbEntity")
      '(100 . "AcDbPolyline")
      '(90 . 2)
      '(43 . 1.0)
      (cons 420 c)
      (cons 10 (list a b))
      (cons 10 (list (1+ a) b))
    )
  )
)
;;画像素点函数
(defun putpixel2 (a b c)
  (entmake
    (list
      '(0 . "LWPOLYLINE")    
      '(100 . "AcDbEntity")
      '(100 . "AcDbPolyline")
      '(90 . 2)
      '(43 . 1.0)
      (cons 62 c)
      (cons 10 (list a b))
      (cons 10 (list (1+ a) b))
    )
  )
)
(defun putpixel1 (a b c)
  (entmake
    (list
      '(0 . "POINT")
      (cons 10 (list a b 0))
      (cons 62 c)
    )
  )
)

;;;===============
;;;HSL值转RGB值   
;;;返回RGB值的列表
;;;===============
;;;Hue转RGB       
(defun Hue-&gt;rgb (v1 v2 vHue / vH)
  (cond
    ((&lt; vHue 0) (setq vH (1+ vHue)))
    ((&gt; vHue 1) (setq vH (1- vHue)))
    (t (setq vH vHue))
  )
  (cond
    ((&lt; (* 6 vH) 1) (+ v1 (* (- v2 v1) 6 vH)))
    ((&lt; (* 2 vH) 1) v2)
    ((&lt; (* 3 vH) 2) (+ v1 (* (- v2 v1) 6 (- 0.66666667 vH))))
    (t v1)
  ) 
)
(defun Hsl-&gt;rgb (Hue Saturation Light / h s l r g b var2 var1)
  (setq h (/ Hue 360.0)
	s (/ Saturation 100.0)
	l (/ Light 100.0)
  )
  (if (= s 0)
    (setq r (* l 255)
	  g (* l 255)
	  b (* l 255)
    )
    (setq var2 (if (&lt; l 0.5)
		 (* l (1+ s))
		 (+ l s (* s l -1))
	       )
          var1 (- (* 2 l) var2)
          r (* 255 (Hue-&gt;RGB var1 var2 (+ h 0.33333333)))
          g (* 255 (Hue-&gt;RGB var1 var2 h))
          b (* 255 (Hue-&gt;RGB var1 var2 (- h 0.33333333)))
    )
  )
  (list (fix r) (fix g) (fix b))
)
;;;===============
;;;RGB值转HSL值   
;;;返回HSL值的列表
;;;===============
(defun RGB-&gt;HSL(R G B / var_R var_G var_B var_min var_max
		        del_max del_R del_G del_B H L S)
  (setq var_R (/ R 255.0))
  (setq var_G (/ G 255.0))
  (setq var_B (/ B 255.0))
  (setq var_min (min var_R var_G var_B))
  (setq var_max (max var_R var_G var_B))
  (setq del_max (- var_max var_min))
  (setq L (/ (+ var_max var_min) 2))
  (if (= del_max 0)
    (setq H 0 S 0)
    (progn 
      (setq S (if (&lt; L 0.5)
                (/ del_max (+ var_max var_min))
                (/ del_max (- 2 var_max var_min))
              )
	    del_R (/ (+ (/ (- var_max var_R) 6)  (/ del_Max 2 )) del_max)
	    del_G (/ (+ (/ (- var_max var_G) 6)  (/ del_Max 2 )) del_max)
	    del_B (/ (+ (/ (- var_max var_B) 6)  (/ del_Max 2 )) del_max)
      )
      (cond
	( (= var_R var_max)
	  (setq H (- del_B del_G))
	)
	( (= var_G var_max)
	  (setq H (+ (/ 1.0 3) del_R (- del_B)))
	)
        ( (= var_B var_max)
	  (setq H (+ (/ 2.0 3) del_G (- del_R)))
	)
      )
      (cond
	( (&lt; H 0) (setq  H (1+ H)))
	( (&gt; H 1) (setq  H (1- H)))
      )
    )
  )
  (setq h (* 360 H)
	S (* 100 S)
	l (* 100 l) 
  )
  (list (fix H) (fix S) (fix L))
)
;;;===============
;;;把truecolordlg 
;;;420构成的数值返
;;;回RGB列表.     
;;;===============
(defun Number-&gt;RGB (C)
  (list (lsh C -16)
        (lsh (lsh C 16) -24)
        (lsh (lsh C 24) -24)
  )
)
;;;===============
;;;把truecolordlg 
;;;420构成的数值返
;;;回RGB列表.     
;;;===============
(defun RGB-&gt;Number (lst)
  (+ (lsh (car lst) 16) (lsh (cadr lst) 8) (caddr lst))
)
;;;===============
;;;RGB转化成索引号
;;;===============
(defun RGB-&gt;Index (colorObj colRGB / )
  (vla-setRGB colorobj (car colRGB) (cadr colRGB) (caddr colRGB)) 
  (vla-get-ColorIndex colorobj)
)
;;;===============
;;;索引号转化成RGB
;;;===============
(defun Index-&gt;RGB (colorobj ci / )
  (vla-put-ColorIndex  colorobj ci)
  (list (vla-get-red   colorobj)
        (vla-get-green colorobj)
        (vla-get-blue  colorobj)
  )
)

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

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

219

220

221

222

223

224

225

226

227

228

229

230

231

232

233

234

235

236

237

238

239

240

241

242

243

244

245

246

247

248

249

250

251

252

253

254

255

256

257

258

259

260

261

262

263

264

265

266

267

;;;************

;;;牛顿迭代分形

;;;************

(defun C:Nt (/ con eps OLDCMD oldsnap t0 gg ita)

(vl-load-com)

(setq *APP (vlax-get-acad-object))

(setq colObj (vla-getinterfaceobject *APP "AutoCAD.AcCmColor.16"))

(setq OLDCMD (getvar "CMDECHO"))

(setq oldsnap (getvar "OSMODE"))

(princ "n请选择三种不同的颜色:")

(princ "n选择颜色1:n")

(setq c1 (acad_truecolordlg 1))

(princ "n选择颜色2:n")

(setq c2 (acad_truecolordlg 3))

(princ "n选择颜色3:n")

(setq c3 (acad_truecolordlg 5))

(setq gg (getint "n输入颜色梯度:"))

(setq sol (getint "n输入分辨率:"))

(setq EPS (getreal "n输入迭代误差:")) ;迭代误差

(setq ita (getint "n最大迭代次数:"))

(if (and c1 c2 c3 gg sol EPS ita)

(progn

(setvar "CMDECHO" 0)

(setvar "OSMODE" 0)

(setq t0 (getvar "TDUSRTIMER"))

(NewTon_fractal sol sol EPS c1 c2 c3 gg ita)

(princ "n画牛顿分形用时")

(princ (* (- (getvar "TDUSRTIMER") t0) 86400))

(princ "秒")

;;(command ".ZOOM" '(39 39) '(361 361))

(command ".ZOOM" "E")

(setvar "OSMODE" oldsnap)

(setvar "CMDECHO" OLDCMD)

)

(alert "n你没有输入有效选择!")

)

(gc)

(princ)

)

(defun trans->RGB (color / ccc)

(if (setq ccc (cdr (assoc 420 color)))

(Number->RGB ccc)

(Index->RGB colObj (cdr (assoc 62 color)))

)

(defun NewTon_fractal(solx soly EPS c1 c2 c3 grad ita /

col1 col2 col3 hsl1 hsl2 hsl3 con xx yy nx ny

cm newx newy x y k)

(setq col1 (trans->RGB c1))

(setq HSL1 (RGB->HSL (car col1) (cadr col1) (caddr col1)))

(setq col2 (trans->RGB c2))

(setq HSL2 (RGB->HSL (car col2) (cadr col2) (caddr col2)))

(setq col3 (trans->RGB c3))

(setq HSL3 (RGB->HSL (car col3) (cadr col3) (caddr col3)))

(setq CON (/ (sqrt 3.0) 2))

(setq xx (/ solX 4.0))

(setq yy (/ solY 4.0))

(setq nx (/ solx -2))

(repeat solx

(setq ny (/ soly -2))

(repeat soly

(setq x (/ nx xx))

(setq y (/ ny yy))

(setq k 0)

(while (and (< k ita) (/= (dist x y) 0))

(setq cm (* 3 (dist x y) (dist x y))

newx (+ (* 2 x (/ 1.0 3)) (/ (- (* x x) (* y y)) cm))

newy (- (* 2 y (/ 1.0 3)) (/ (* 2 x y) cm))

x newx

y newy

)

(cond

( (< (dist (1- x) y) EPS)

(putcolor hsl1 nx ny k)

(setq k ita)

)

( (< (dist (+ x 0.5) (- y con)) EPS)

(putcolor hsl2 nx ny k)

(setq k ita)

)

( (< (dist (+ x 0.5) (+ y con)) EPS)

(putcolor hsl3 nx ny k)

(setq k ita)

)

(setq k (1+ k))

)

(setq ny (1+ ny))

)

(setq nx (1+ nx))

)

;;距离平方函数

(defun dist (a b)

(+ (* a a) (* b b))

)

(defun putcolor (HSL nx ny k / nH ncolor)

(setq nH (rem (+ (car HSL) (* grad k)) 361))

(setq ncolor (hsl->rgb nH (cadr hsl) (caddr hsl)))

(setq ncolor (rgb->number ncolor))

(putpixel nx ny ncolor)

)

;;;==========================

;;;用entmake方法画像素点函数

;;;==========================

(defun putpixel (a b c)

(entmake

(list

'(0 . "LWPOLYLINE")

'(100 . "AcDbEntity")

'(100 . "AcDbPolyline")

'(90 . 2)

'(43 . 1.0)

(cons 420 c)

(cons 10 (list a b))

(cons 10 (list (1+ a) b))

)

;;画像素点函数

(defun putpixel2 (a b c)

(entmake

(list

'(0 . "LWPOLYLINE")

'(100 . "AcDbEntity")

'(100 . "AcDbPolyline")

'(90 . 2)

'(43 . 1.0)

(cons 62 c)

(cons 10 (list a b))

(cons 10 (list (1+ a) b))

)

(defun putpixel1 (a b c)

(entmake

(list

'(0 . "POINT")

(cons 10 (list a b 0))

(cons 62 c)

)

;;;===============

;;;HSL值转RGB值

;;;返回RGB值的列表

;;;===============

;;;Hue转RGB

(defun Hue->rgb (v1 v2 vHue / vH)

(cond

((< vHue 0) (setq vH (1+ vHue)))

((> vHue 1) (setq vH (1- vHue)))

(t (setq vH vHue))

)

(cond

((< (* 6 vH) 1) (+ v1 (* (- v2 v1) 6 vH)))

((< (* 2 vH) 1) v2)

((< (* 3 vH) 2) (+ v1 (* (- v2 v1) 6 (- 0.66666667 vH))))

(t v1)

)

(defun Hsl->rgb (Hue Saturation Light / h s l r g b var2 var1)

(setq h (/ Hue 360.0)

s (/ Saturation 100.0)

l (/ Light 100.0)

)

(if (= s 0)

(setq r (* l 255)

g (* l 255)

b (* l 255)

)

(setq var2 (if (< l 0.5)

(* l (1+ s))

(+ l s (* s l -1))

)

var1 (- (* 2 l) var2)

r (* 255 (Hue->RGB var1 var2 (+ h 0.33333333)))

g (* 255 (Hue->RGB var1 var2 h))

b (* 255 (Hue->RGB var1 var2 (- h 0.33333333)))

)

(list (fix r) (fix g) (fix b))

)

;;;===============

;;;RGB值转HSL值

;;;返回HSL值的列表

;;;===============

(defun RGB->HSL(R G B / var_R var_G var_B var_min var_max

del_max del_R del_G del_B H L S)

(setq var_R (/ R 255.0))

(setq var_G (/ G 255.0))

(setq var_B (/ B 255.0))

(setq var_min (min var_R var_G var_B))

(setq var_max (max var_R var_G var_B))

(setq del_max (- var_max var_min))

(setq L (/ (+ var_max var_min) 2))

(if (= del_max 0)

(setq H 0 S 0)

(progn

(setq S (if (< L 0.5)

(/ del_max (+ var_max var_min))

(/ del_max (- 2 var_max var_min))

)

del_R (/ (+ (/ (- var_max var_R) 6) (/ del_Max 2 )) del_max)

del_G (/ (+ (/ (- var_max var_G) 6) (/ del_Max 2 )) del_max)

del_B (/ (+ (/ (- var_max var_B) 6) (/ del_Max 2 )) del_max)

)

(cond

( (= var_R var_max)

(setq H (- del_B del_G))

)

( (= var_G var_max)

(setq H (+ (/ 1.0 3) del_R (- del_B)))

)

( (= var_B var_max)

(setq H (+ (/ 2.0 3) del_G (- del_R)))

)

(cond

( (< H 0) (setq H (1+ H)))

( (> H 1) (setq H (1- H)))

)

(setq h (* 360 H)

S (* 100 S)

l (* 100 l)

)

(list (fix H) (fix S) (fix L))

)

;;;===============

;;;把truecolordlg

;;;420构成的数值返

;;;回RGB列表.

;;;===============

(defun Number->RGB (C)

(list (lsh C -16)

(lsh (lsh C 16) -24)

(lsh (lsh C 24) -24)

)

;;;===============

;;;把truecolordlg

;;;420构成的数值返

;;;回RGB列表.

;;;===============

(defun RGB->Number (lst)

(+ (lsh (car lst) 16) (lsh (cadr lst) 8) (caddr lst))

)

;;;===============

;;;RGB转化成索引号

;;;===============

(defun RGB->Index (colorObj colRGB / )

(vla-setRGB colorobj (car colRGB) (cadr colRGB) (caddr colRGB))

(vla-get-ColorIndex colorobj)

)

;;;===============

;;;索引号转化成RGB

;;;===============

(defun Index->RGB (colorobj ci / )

(vla-put-ColorIndex colorobj ci)

(list (vla-get-red colorobj)

(vla-get-green colorobj)

(vla-get-blue colorobj)

)

高飞鸟的天空

有一次，我们梦见大家都是不相识的。我们醒了，却知道我们原是相亲爱的。

牛顿分形的LISP程序

Leave a comment 取消回复