?? fractal_dialog5.lsp
字號:
;;;============
;;;對話框函數集
;;;============
;;;開啟新對話框
(defun NewDCL ()
;;(new_dialog "fractal" ID)
(zoom "I3")
(zoom "I4")
(action) ;設定各按鈕動作
(put_value allkey)
(addlist "L2" listL2) ;推薦值列表
(set_tile "L2" L2)
(if (= R1 "T1") ;若是Mandelbrot
(mode_tile "A1" 1) ;則初始值不可用
(mode_tile "A1" 0)
)
(color_init) ;初始化顏色值
)
;;;動作函數
(defun action ()
(action_tile "accept" "(progn (done_dialog 1) (setq option 1))")
(action_tile "cancel" "(progn (done_dialog 0) (setq option 0))")
(action_tile "help" "(fractal_help)")
(action_tile "P1" "(done_dialog 3)")
(action_tile "P2" "(done_dialog 2)")
(action_tile "P3" "(preview)")
(action_tile "R1" "(choose $value)")
(action_tile "R3" "(setq R3 $value)")
(action_tile "X0" "(setq X0 $value)")
(action_tile "Y0" "(setq Y0 $value)")
(action_tile "X1" "(setq X1 $value)")
(action_tile "Y1" "(setq Y1 $value)")
(action_tile "X2" "(setq X2 $value)")
(action_tile "Y2" "(setq Y2 $value)")
(action_tile "J1" "(setq J1 $value)")
(action_tile "J2" "(setq J2 $value)")
(action_tile "J3" "(setq J3 $value)")
(action_tile "M1" "(setq M1 $value)")
(action_tile "M2" "(setq M2 $value)")
(action_tile "M3" "(setq M3 $value)")
(action_tile "M4" "(setq M4 $value)")
(action_tile "G1" "(setq G1 $value)")
(action_tile "L1" "(progn (setq L1 $value) (set_tile \"S1\" L1) (setq S1 L1))")
(action_tile "L2" "(list2)")
(action_tile "D1" "(default)")
(action_tile "D2" "(restore)")
(action_tile "D3" "(save_Arguments)")
(action_tile "I1" "(done_dialog 2)")
(action_tile "I2" "(ImageButton $x $y)")
(action_tile "I3" "(ZoomScaled 0.25)")
(action_tile "I4" "(ZoomScaled -0.5)")
)
;;;取得主對話框的各參數值
(defun get_value ()
(mapcar 'set alllst (mapcar 'get_tile allkey))
(setq R2 (list M1 M2 M3 M4))
)
;;;把各參數值填入主對話框
(defun put_value (keylst)
(foreach n keylst
(set_tile n (eval (read n)))
)
)
;;;初始化顏色RGB值
(defun color_init (/ col2)
(setq col2 (apply 'strcat (mapcar (function (lambda (x) (strcat x " "))) col1)))
(setq col2 (substr col2 1 (1- (strlen col2))))
(set_tile "C2" col2)
(start_image "I1")
(fill_image 0 0 IX1 IY1 icol)
(end_image)
)
;;;添加列表
(defun AddList (key items)
(start_list key)
(mapcar 'add_list items)
(end_list)
)
;;;幫助函數
(defun fractal_help ( / f f1)
(setq f1 (findfile "fractal_help.txt"))
(setq f (open f1 "r"))
(close f) ;關閉文件
(startapp "notepad" f1) ;啟動記事本打開數據
)
;;;默認值函數
(defun default ()
(if (= R1 "T1")
(setq X1 "-2.25"
X2 "0.75"
X0 "0"
Y0 "0"
)
(setq X1 "-1.50"
X2 "1.50"
X0 "0"
Y0 "0.66"
)
)
(setq Y1 "-1.50"
Y2 "1.50"
J1 "255"
J2 "256 256"
J3 "20"
G1 "3"
M1 "1"
M2 "0"
M3 "0"
M4 "0"
R3 "T3"
S1 "2"
L1 "2"
L2 "0"
)
(put_value allkey)
)
;;;開關狀態
(defun key_status (keylst k)
(foreach n keylst
(mode_tile n k)
)
)
(defun choose (s)
(if (= s "T1")
(mode_tile "A1" 1)
(mode_tile "A1" 0)
)
(setq R1 s)
)
;;;推薦列表函數
(defun list2 (/ L3)
(setq L3 (atoi $value))
(setq L3 (nth L3 listL2))
(setq L3 (vl-string-subst "\" \"" " " L3))
(setq L3 (read (strcat "(\"" L3 "\")")))
(setq X0 (car L3))
(setq Y0 (cadr L3))
(set_tile "X0" X0)
(set_tile "Y0" Y0)
(setq L2 $value)
)
;;;恢復上次函數
(defun restore (/ catchit)
(setq catchit (vl-catch-all-apply 'last_time))
(if (vl-catch-all-error-p catchit)
(alert "讀參數文件錯誤!")
)
)
(defun last_time (/ saved_file file last_value)
(setq last_value nil)
(if
(and
(setq saved_file (vl-registry-read "HKEY_CURRENT_USER\\Fractal"))
(setq file (open saved_file "r"))
(while (setq n (read-line file))
(setq last_value (cons n last_value))
)
(setq last_value (reverse last_value))
)
(progn
(close file)
(mapcar 'set_tile allkey last_value)
(get_value)
(choose R1)
(setq col0 (car last_value))
(setq col0 (strcat "(" col0 ")"))
(setq col0 (read col0))
(setq col1 (mapcar 'itoa col0))
(setq icol (rgb->index colObj col0))
(color_init)
)
(alert "沒有存儲上次的!")
)
)
;;;保存參數函數
(defun save_Arguments (/ last_value saved_file file)
(setq last_value (mapcar 'eval alllst))
(if (setq saved_file (getfiled "保存分形參數" "C:\\" "txt" 1))
(progn
(setq file (open saved_file "w"))
(foreach n last_value
(princ n file)
(princ "\n" file)
)
(close file) ;關閉文件
(vl-registry-write "HKEY_CURRENT_USER\\Fractal" "" saved_file)
saved_file
)
)
)
;;;畫放大縮小按鈕函數
(defun zoom (key / x+ y+ cenX cenY rad ang i j)
(start_image key)
(setq x+ (dimx_tile key))
(setq y+ (dimx_tile key))
(setq cenX (fix (/ x+ 2)))
(setq cenY (fix (/ y+ 2)))
(setq rad (- (min cenx ceny) 2))
(fill_image 0 0 x+ y+ 7)
(setq ang (/ PI 0.5 60))
(setq i 0)
(repeat 60
(vector_image
(fix (+ (* Rad (cos (* ang (- i 0.5)))) cenX))
(fix (+ (* Rad (sin (* ang (- i 0.5)))) cenY))
(fix (+ (* Rad (cos (* ang (+ i 0.5)))) cenX))
(fix (+ (* Rad (sin (* ang (+ i 0.5)))) cenY))
0
)
(setq i (1+ i))
)
(vector_image (- cenx rad -2) ceny (+ ceny rad -2) ceny 0)
(if (= key "I3")
(vector_image cenx (- ceny rad -2) cenx (+ ceny rad -2) 0)
)
(end_image)
)
;;;放大縮小函數
(defun ZoomScaled (n / oldx1 oldx2 oldy1 oldy2 dx dy)
(and
X1 Y1 X2 Y2
(setq oldx1 (atof x1))
(setq oldx2 (atof x2))
(setq oldy1 (atof y1))
(setq oldy2 (atof y2))
(setq dx (- oldx2 oldx1))
(setq dy (- oldy2 oldy1))
(set_tile "X1" (rtos (+ oldx1 (* dx n)) 2 20))
(set_tile "Y1" (rtos (+ oldy1 (* dy n)) 2 20))
(set_tile "X2" (rtos (- oldx2 (* dx n)) 2 20))
(set_tile "Y2" (rtos (- oldy2 (* dy n)) 2 20))
(preview)
)
)
;;;============
;;;點取界限函數
;;;============
(defun getlimits (/ lx1 lx2 ly1 ly2 pt1 pt2 L&B R&U)
(if
(and
(setq sol (read (strcat "(" J2 ")"))) ;分辨率
(if (null (cadr sol))
(setq sol (list (car sol) (car sol)))
(setq sol sol)
)
(= (type (car sol)) 'INT)
(> (car sol) 0)
(= (type (cadr sol)) 'INT)
(> (cadr sol) 0) ;分辨率參數有效
(if (= R1 "T2") ;類型
(setq lx1 (* (car sol) -1.50)
lx2 (* (car sol) 1.50)
ly1 (* (cadr sol) -1.50)
ly2 (* (cadr sol) 1.50)
)
(setq lx1 (* (car sol) -2.25)
lx2 (* (car sol) 0.75)
ly1 (* (cadr sol) -1.50)
ly2 (* (cadr sol) 1.50)
)
)
(null
(vla-zoomwindow
*APP
(vlax-3d-point (list lx1 ly1))
(vlax-3d-point (list lx2 ly2))
)
)
(null (vla-zoomscaled *APP 0.8 acZoomScaledRelative));放大圖形
(entmake
(list
'(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
'(90 . 4)
'(62 . 1)
(cons 10 (list lx1 ly1))
(cons 10 (list lx2 ly1))
(cons 10 (list lx2 ly2))
(cons 10 (list lx1 ly2))
'(70 . 1)
)
) ;畫范圍框
(null (initget 33))
(setq pt1 (getpoint "\n選取第一點:"))
(null (initget 33))
(setq pt2 (getpoint "\n選取第二點:"))
(setq L&B (mapcar '/ pt1 sol))
(setq R&U (mapcar '/ pt2 sol))
(null (vla-delete(vlax-ename->vla-object (entlast))));刪除范圍框
)
(progn ;得到范圍參數
(new_dialog "fractal" ID)
(NewDCL)
(set_tile "X1" (rtos (car L&B) 2 20))
(set_tile "Y1" (rtos (cadr L&B) 2 20))
(set_tile "X2" (rtos (car R&U) 2 20))
(set_tile "Y2" (rtos (cadr R&U) 2 20))
)
(progn
(alert "繪制范圍或圖像像素參數無效!")
(new_dialog "fractal" ID)
(NewDCL)
)
)
)
;;;============
;;;選取顏色函數
;;;============
(defun pick_color ()
(if (setq c1 (acad_TrueColorDlg 10))
(if (setq c0 (cdr (assoc 420 c1)))
(setq icol (cdr (assoc 62 c1))
col0 (Number->RGB C0)
col1 (mapcar 'itoa col0)
)
(setq icol (cdr (assoc 62 c1))
col0 (Index->RGB colObj icol)
col1 (mapcar 'itoa col0)
)
)
)
)
;;;============
;;;圖像預覽函數
;;;============
(defun Preview (/ time)
(get_value)
(start_image "I2")
(fill_image 0 0 IX2 IY2 -2)
(if (check)
(progn
(setq t0 (getvar "TDUSRTIMER"))
(if (= R1 "T1")
(Mandelbrot J1 (list IX2 IY2) J3 X0 Y0 X1 Y2 X2 Y1 col0 G1 R2 R3 1 S1)
(Julia J1 (list IX2 IY2) J3 X0 Y0 X1 Y2 X2 Y1 col0 G1 R2 R3 1 S1)
)
(princ "\n預覽分形用時")
(princ (setq time (* (- (getvar "TDUSRTIMER") t0) 86400)))
(princ "秒\n")
)
(alert "參數輸入有誤!")
)
(end_image)
(get_value)
(setq option 4)
)
;;;============
;;;參數值的檢查
;;;============
(defun check ()
(and J1 J2 J3 X0 Y0 X1 Y1 X2 Y2 col0 G1
(setq J1 (abs (fix (atof J1)))) ;迭代次數
(> J1 1)
(setq J2 (read (strcat "(" J2 ")")));分辨率
(if (null (cadr J2))
(setq J2 (list (car J2) (car J2)))
(setq J2 J2)
)
(= (type (car J2)) 'INT)
(> (car J2) 0)
(= (type (cadr J2)) 'INT)
(> (cadr J2) 0)
(setq J3 (abs (atof J3))) ;逃逸半徑
(> J3 1)
(setq X0 (atof X0)) ;初始值X0
(setq Y0 (atof Y0)) ;初始值Y0
(setq X1 (atof X1)) ;左下角X1
(setq X2 (atof X2)) ;左下角Y1
(not (equal X1 X2 1e-16)) ;不能相等
(setq Y1 (atof Y1)) ;右上角X2
(setq Y2 (atof Y2)) ;右上角Y2
(not (equal Y1 Y2 1e-16)) ;不能相等
(setq G1 (abs (fix (atof G1)))) ;顏色梯度
(>= G1 0)
(setq R2 (list M1 M2 M3 M4))
)
)
;;;============
;;;圖像按鈕函數
;;;============
(defun ImageButton ($x $y / minxx maxxx minyy maxyy)
(setq TX1 (atof X1))
(setq TX2 (atof X2))
(setq TY1 (atof Y1))
(setq TY2 (atof Y2))
(setq lxx (- TX2 TX1))
(setq lyy (- TY2 TY1))
(setq xx1 $X)
(setq yy1 $y)
(if (= j 0)
(setq xx2 xx1 yy2 yy1 j (1+ j))
(progn
(setq minxx (min xx1 xx2))
(setq maxxx (max xx1 xx2))
(setq minyy (min yy1 yy2))
(setq maxyy (max yy1 yy2))
(start_image "I2")
(vector_image xx1 yy1 xx2 yy1 1)
(vector_image xx2 yy1 xx2 yy2 1)
(vector_image xx2 yy2 xx1 yy2 1)
(vector_image xx1 yy2 xx1 yy1 1)
(end_image)
(setq dx1 (+ TX1 (* lxx (/ minxx IX2 1.0))))
(setq dy1 (+ TY1 (* lyy (/ (- IY2 maxyy) IY2 1.0))))
(setq dx2 (+ TX1 (* lxx (/ maxxx IX2 1.0))))
(setq dy2 (+ TY1 (* lyy (/ (- IY2 minyy) IY2 1.0))))
(setq X1 (rtos dx1 2 20))
(setq Y1 (rtos dy1 2 20))
(setq X2 (rtos dx2 2 20))
(setq Y2 (rtos dy2 2 20))
(set_tile "X1" X1)
(set_tile "Y1" Y1)
(set_tile "X2" X2)
(set_tile "Y2" Y2)
(setq j 0)
)
)
)
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -