[原创]：无级放大和预览的技术以及对话框的设计

highflybird

                               
登录/注册后可看大图

对lisp程序来说，对话框的设计是一件痛苦的事情，也是一件有意义的事情。为交流经验下面我来和大家一起探讨这里面的技术问题。

一  首先简单介绍一下对话框的设计流程:

2. 
   
3. ……                             ;程序开始
   
4. (setq ok 2)                      ;初始化对话框的确定数值（不一定要）
   
5. (setq ID (load_dialog "***.dcl"));加载对话框文件,ID为对话框的标志号
   
6. (if (> ID 0)                     ;标志号如果大于0，则加载对话框成功
   
7.   (if (new_dialog "***" ID)      ;如果显示对话框成功   
   
8.     (progn
   
9.     (……)                     ;初始化控件
   
10.     (while (> ok 1)            ;直到用户离开对话框                                   
    
11.       (setq ok (start_dialog)) ;激活对话框
    
12.       ……                     ;用户操纵对话框
    
13.       (cond                    ;这一段不一定都要
    
14.         ((= ok 2 之类)
    
15.          (执行OK动作)
    
16.         )
    
17.       )
    
18.     )
    
19.     (……)                     ;离开对话框后的程序
    
20.   )
    
21.   (alert “对话框错误!”)      ;显示出错信息
    
22. )
    
23. (alert “对话框加载错误!”)    ;显示加载失败信息
    
24. )
    
25. (unload_dialog ID)               ;卸载对话框
    
26. ;(一定要，我曾经没这一句吃过大亏)
    
27. ……                             ;程序结束
    

<br /> ……                             ;程序开始 <br /> (setq ok 2)                      ;初始化对话框的确定数值（不一定要）<br /> (setq ID (load_dialog "***.dcl"));加载对话框文件,ID为对话框的标志号 <br /> (if (> ID 0)                     ;标志号如果大于0，则加载对话框成功<br />   (if (new_dialog "***" ID)      ;如果显示对话框成功   <br />     (progn <br />     (……)                     ;初始化控件<br />     (while (> ok 1)            ;直到用户离开对话框                                   <br />       (setq ok (start_dialog)) ;激活对话框<br />       ……                     ;用户操纵对话框<br />       (cond                    ;这一段不一定都要<br />         ((= ok 2 之类)<br />          (执行OK动作)<br />         )<br />       )<br />     )<br />     (……)                     ;离开对话框后的程序<br />   ) <br />   (alert “对话框错误!”)      ;显示出错信息<br /> )<br /> (alert “对话框加载错误!”)    ;显示加载失败信息<br /> ) <br /> (unload_dialog ID)               ;卸载对话框<br /> ;(一定要，我曾经没这一句吃过大亏)<br /> ……                             ;程序结束<br />

二  对话框的布局和美观设计
    一个好看的对话框，能给别人留下好的印象。因而在布局时候，不要弄得参差不齐，最好整齐一致，各组件和文字不要显得太挤太密和太空，疏密要恰当。
因而很有必要用 width,fixed_width,alignment,spacer,spacer_0之类的语句或控件来使之漂亮。
三  对话框的初始化和列表的处理
在初始化中,一般来说:
用(action_tile key action_expression) 来处理各控件的相应动作.
用(mode_tile key mode)来处理控件的状态（可用，禁用，聚焦，等）
用(get_attr key attribute)来沪的控件相应属性的值。
用(get_tile key) 来获得控件的值。
用(set_tile key value)来设定控件的值。
用(dimX_tile key) ，(dimY_tile key)来获得控件的高宽或像素。
对于列表(popup_list ,list,list_box)的处理可以有两种方式赋予初始值
一种在DCL中直接写入，另外就是在lisp程序中设置。为了正确显示或取得各列表的值，一般来说要定义字符串和列表相互转化的函数,大家可以参考我的程序。
四  如何调用已有CAD的对话框控件并获得其返回值
Alert ,help ,getfiled ,acad_colordlg,acad_truecolordlg (R2004以上)
有的对话框有返回值，像颜色，文件对话框。颜色对话框的返回值为颜色号，若采用真彩色，(acad_truecolordlg 0) 则返回值一般如下:
((62 . 75) (420 . 7510105)),第一个表为62 . 75 指的是62 颜色 75,颜色索引号，420,真彩色，7510105真彩色颜色数值可以直接传给图元表。
Getfiled,返回值为文件路径，具体用法请参考相关资料。
五  隐藏、恢复对话框及嵌套的处理。
有时候需要交互操作，暂时离开对话框时，这时候的处理办法要先将对话框隐藏，待交互操作结束后，恢复对话框。
例如这样的一个流程:

2. 
   
3. (while (> ok 1)                             ;直到用户按下OK键
   
4.   ……                                      ;初始化对话框   
   
5. (action_tile “pick” “(done_dialog 2)”);需要在图面上点取         
   
6.     (setq ok (start_dialog))                  ;激活对话框  
   
7.     (cond                    
   
8.       ((= ok 2)
   
9.        (pick)                                 ;点取动作
   
10.        (new_dialog "***" ID)                  ;新对话框
    
11.        (……)                                 ;初始化等
    
12.       )
    
13.     )
    
14.   )
    

<br /> (while (> ok 1)                             ;直到用户按下OK键<br />   ……                                      ;初始化对话框   <br /> (action_tile “pick” “(done_dialog 2)”);需要在图面上点取          <br />     (setq ok (start_dialog))                  ;激活对话框  <br />     (cond                    <br />       ((= ok 2)<br />        (pick)                                 ;点取动作<br />        (new_dialog "***" ID)                  ;新对话框<br />        (……)                                 ;初始化等<br />       )<br />     )<br />   )<br />

  关于嵌套对话框的设计和处理:
  对话框文件可包含父对话框，子对话框。在父对话框中增加一个子对话框按钮,初始化子对话框函数中应包含new_dialog,start_dialog。其他处理跟上面的处理有些类似。
六  对话框中参数值的默认、保存和恢复
默认的处理: 在开始时对各控件赋值，或者定义这样的一个按钮和函数。
保存参数值，一般来说有几种方式：
1、        设置全局变量。但这样只对这次CAD有效，下次打开CAD就不行了。
2、        保存到用户变量中。CAD中有15个用户变量，可供自己定义。
3、        保存到数据文件,下次调用这个数据文件。
4、        保存到注册表中。
我这个lisp中就采用了两种方法结合，即用注册表记录其保存的数据文件路径。然后下次调用时就打开那个数据文件。当然还有其他方式。大家不妨探讨一下。
恢复参数值：就是把各控件保存的值调出来后用set_tile函数赋分别给它。
七  图像组件的预览和放大和缩小技术
    预览在很多方面用的着，譬如方程曲线，分形图像等等。
首先用dimX_tile,dimY_tile获得图像组件像素的高宽。
然后(start_image key)开始图像处理。
用(vector_image  x1 y1 x2 y2 color)来画线
用(fill_image x1 y1 x2 y2 color)来填充或画点。
用(slide_image x1 y1 x2 y2 slideName)来显示幻灯片。
用(end_image)结束图像控件的处理。
预览技术是建立在对图像控件的坐标系统和CAD坐标系统的转换上的。弄清楚了它们的转换关系，那么，就能写出预览函数了。
坐标的处理上，要注意的是图像的原点是左上角，而不是左下角。因而对于函数的某个区域(X1,Y1),(X2,Y2)要映射到图像组件的坐标系统中去，这样的话，放大和缩小函数的处理就比较好办了。
各位如果有兴趣的话，不妨看看我下面程序的处理，这个对话框是为分形而设计的。为了展示分形的自相似，和一个参数的微小变化，就可以引起图像的很大变化（混沌系统的一个特征），因而有必要采取无级放大。
如果在图像按钮上点击一下，再点击一下，得到放大区域（红色矩形线框），对这个区域预览，就可以细看其局部。你甚至可以对它放大再放大，直到它们的上下界限相等（达到lisp的精确极限1e-16）,你会发现，放大之后好像图像没什么变化，还是那个形状—这正是分形的自相似特征。
只可惜lisp程序对图像处理速度不快，而且又受本身速度的限制，使得这个预览打了一个很大的折扣。
各位要用的话最好把这个程序几个文件编译成.vlx文件，速度会提高不少。

匆匆写来，有很多错误，请大家批评指教。

highflybird

http://www.mjtd.com/bbs/dispbbs. ... 5&replyID=59385
不能下载附件---------我也没办法，请参考上面地址的附件吧。
对话框:
[php]
//主对话框fractal.dcl
fractal : dialog {
  key = "ALL";
  label = "参数控制";
  is_cancel = true;
  spacer;
  : row {
    : column {
      : row {
        : column {
          : boxed_radio_column {
            key = "R1";
            label = "图像类型";
            value = "T2";
            : radio_button {
              key = "T1";
              label = "Mandelbrot";
            }
            : radio_button {
              key = "T2";
              label = "Julia";
            }
          }
          : boxed_row {
            label = "迭代次方(选2-6)";
            : slider {
              key = "L1";
              min_value = 2;
              max_value = 6;     
              small_increment = 1;
              big_increment = 1;
              value = 2;
            }
            : text {
              key = "S1";
              value = "2";
            }
          }
        }
        : boxed_row {
          label= "左下角和右上角坐标(绘制范围)";
          : column {
            : edit_box {
              key = "X1";
              label = "X1:";
              value = -1.5;
              width = 27;
            }
            : edit_box {
              key = "Y1";
              label = "Y1:";
              value = -1.5;
            }
            : edit_box {
              key = "X2";
              label = "X2:";
              value = 1.5;
            }
            : edit_box {
              key = "Y2";
              label = "Y2:";
              value = 1.5;
            }
            spacer;
          }
          : column {
            spacer;
            : button {
              key = "P1";
              label= "点取";
            }
            spacer;
          }
        }
      }
      : row {   
        : boxed_column {
          label= "精度控制";
          : edit_box {
            key = "J1";
            label = "迭代次数";
            value = 255;
          }
          : edit_box {
            key = "J2";
            label = "图像像素";
            value = "256 256";
          }
          : edit_box {
            key = "J3";
            label = "逃逸半径";
            value = 20;
          }
          spacer;
        }
        : boxed_column {
          key = "A1";
          label= "Julia集初始值";
          : row {
            : edit_box {
              key = "X0";
              label = "X:";
              value = 0.00;
            }
            : text {
              label= " 如:0.00";
              fixed_width = true;
            }
          }
          : row {
            : edit_box {
              key = "Y0";
              label = "Y:";
              value = 0.66;
            }
            : text {
              label= " 如:0.66";
              fixed_width = true;
            }
          }
          : row {
            : text {
              label = "推荐列表";
            }
            : popup_list {
              key = "L2";
              list = "0.0 0.66\n0.7453 0.11301\n0 1.0\n1.0 0\n-1.0 0\n0 -1.0\n-0.10281 0.95723"
                     "\n-0.76 -0.08\n-0.46 0.57\n-0.12256 0.74486\n-1.16 -0.25\n-1.25 -0.01"
                     "\n-0.199 -0.66\n0.25 0.52\n-0.615 -0.43\n-0.77 0.08\n-0.48176 -0.53163"
                     "\n-0.2 0.75\n0.11 0.66\n0.5 0.55\n0.32 0.04\n0.34 0.45\n-0.618 0.618";
              value = 0;
              width = 19;
            }
          }
          spacer;
        }
      }
      : boxed_radio_row {
        key = "R3";
        label = "逃逸控制";
        value = "T3";
        : radio_button {
          key = "T3";
          label = "标准方式";
        }
        : radio_button {
          key = "T4";
          label = "X 逃逸";
        }
        : radio_button {
          key = "T5";
          label = "Y 逃逸";
        }
        : radio_button {
          key = "T6";
          label = "斑纹";
        }
        : radio_button {
          key = "T7";
          label = "自定义";
          fixed_width = true;
        }
      }
      : boxed_column {
        label = "颜色控制";
        : row {
          : text {
            label = "渐变方式";
          }
          spacer_1;
          : toggle {
            key = "M1";
            label = "色泽度";
            value = "1";
          }
          : toggle {
            key = "M2";
            label = "饱和度";
          }
          : toggle {
            key = "M3";
            label = "明暗度";
          }
          : toggle {
            key = "M4";
            label = "红绿蓝";
          }
        }
        : row {
          fixed_width = true;
          : edit_box {
            key = "G1";
            label = "颜色梯度";
            width = 22.5;
            fixed_width = true;
            value = 3;
          }
          : button {
            key = "P2";
            label= "初始色";
            fixed_width = true;
          }
          : text {
            key = "C2";
            label = "255 255 255";
          }
          : swatch {
            key = "I1";
            width = 7.5;
            aspect_ratio = 0.4;
            fixed_width = true;
            fixed_height = true;
            color = 7;
          }
        }
        spacer;
      }
    }
    : boxed_column {
      label = "图像预览";
      spacer;
      : image_button {
        key = "I2";
        height = 20;
        aspect_ratio = 1;
        fixed_width = true;
        fixed_height = true;
        alignment = centered;
        color = -2;
      }
      spacer;
      : row {
        fixed_width = true;
        alignment = centered;
        : image_button {
          key = "I3";
          height = 1.5;
          aspect_ratio = 1;
          fixed_width = true;
          fixed_height = true;
          color = -15;
        }
        : slider {
          width = 31;
        }
        : image_button {
          key = "I4";
          height = 1.5;
          aspect_ratio = 1;
          fixed_width = true;
          fixed_height = true;
          color = -15;
        }
      }
      spacer;
      : button {
        key = "P3";
        label = "预览";
        width = 31;
        alignment = centered;
      }
      spacer;
    }
  }
  : row {
    : row {
      width =62;
      fixed_width = true;
      spacer_0;
      : button {
        key = "D1";
        label = "默认参数";
        fixed_width = true;
      }
      : button {
        key = "D2";
        label = "恢复上次";
        fixed_width = true;
      }
      : button {
        key = "D3";
        label = "保存参数";
        fixed_width = true;
      }
      spacer_0;
    }
    ok_cancel_help;
  }
}
[/php]
源程序:
[php]
;;;==========================
;;;用CAD画Julia或Mandelbrot的
;;;主程序,采用逃逸算法      
;;;highflybird 2007/03/05.KM.
;;;==========================
(prompt "\n请输入命令JL")
(defun C:JL (/ *APP colboj listL2 allkey alllst c0 c1 col0 col1 icol ID ok option j
               R1 R2 R3 S1 L2 X0 X1 X2 Y0 Y1 Y2 J1 J2 J3 G1 C2 t0 IX1 IY1 IX2 IY2 del
               TX1 TY1 TX2 TY2 xx1 yy1 xx2 yy2 lxx lyy Dx1 Dy1 Dx2 Dy2 M1 M2 M3 M4)
  (vl-load-com)
  (setq *APP (vlax-get-acad-object))
  (setq        colObj (vla-getinterfaceobject *APP "AutoCAD.AcCmColor.16"))                 
  (setq        allkey (list "C2""R1""R3""S1""L1""L2""X0""X1""X2""Y0""Y1""Y2""J1""J2""J3""G1""M1""M2""M3""M4"))
  (setq        alllst (mapcar 'read allkey))
  (setq c0   (rnd 0 (* 256 256 256))                           ;颜色随机
        col0 (Number->RGB C0)                                  ;转化为RGB
        col1 (mapcar 'itoa col0)                               ;转化为字符串
        icol (rgb->index colObj col0)                               ;转化为索引号
  )
  (setq j 0)
  (setq ok 2)   
  (setq ID (load_dialog "fractal5.dcl"))                       ;加载对话框
  (if (new_dialog "fractal" ID)                                ;如果成功
    (progn
      (setq IX1 (dimx_tile "I1"))                              ;图像1真实X尺寸
      (setq IY1 (dimy_tile "I1"))                              ;图像1真实Y尺寸
      (setq IX2 (dimx_tile "I2"))                              ;图像2真实X尺寸
      (setq IY2 (dimy_tile "I2"))                              ;图像2真实Y尺寸
      (setq listL2 (get_attr "L2" "list"))                     ;推荐值列表
      (setq listL2 (string->list listL2))
      (setq R1 "T2")                                           ;默认为JULIA
      (setq C2 "")                                             
      (default)                                                ;各默认值
      (newDCL)                                                
      (get_value)                                              ;取得各对话框值
      (while (> ok 1)                                      
        (setq ok (start_dialog))                               ;开始对话框
        (cond
          ( (= ok 2)                                           ;如果按下初始颜色
            (pick_color)                                       ;取得颜色
            (new_dialog "fractal" ID)
            (NewDCL)                                           ;开新对话框
            (get_value)                                        ;取得其值
            (setq option 2)
          )
          ( (= ok 3)                                           ;如果按下点取按钮
            (getlimits)                                        ;取得上下左右界限
            (get_value)                                        ;取得其值
            (setq option 3)
          )
        )
      )                                                  
      (cond
        ( (= option 0)
          (princ "\n你已取消操作!")
        )  
        ( (and (= option 1) (check))                           ;参数检查
          (setq t0 (getvar "TDUSRTIMER"))                       ;开始计时
          (if (= R1 "T1")                                       ;判断类型
            (Mandelbrot J1 J2 J3 X0 Y0 X1 Y1 X2 Y2 col0 G1 R2 R3 0 S1)
                                                               ;画曼氏图
            (Julia J1 J2 J3 X0 Y0 X1 Y1 X2 Y2 col0 G1 R2 R3 0 S1)
                                                               ;画朱氏图
          )
          (princ "\n画分形用时")
          (princ (* (- (getvar "TDUSRTIMER") t0) 86400))       ;计时结束
          (princ "秒\n")
          (vla-zoomwindow *APP
            (vlax-3d-point (list 0 0))
            (vlax-3d-point J2)
          )                                                
          (vla-zoomscaled *APP 0.9 acZoomScaledRelative)       ;放大图形
        )
        (t (alert "数据输入有误!"))
      )
    )
    (alert "对话框加载错误!")
  )
  (unload_dialog ID)                                           ;卸载对话框
  (gc)                                                         ;清理内存
  (princ)                                                      ;静默退出
)
[/php]
[php]
;;;============
;;;对话框函数集
;;;============

;;;开启新对话框
(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)
    )
  )
)
[/php]
[php]
;;;==========================
;;;Julia算法函数(带参数)     
;;;==========================
(defun Julia (J1 J2 J3 X0 Y0 X1 Y1 X2 Y2 col0 G1 R2 R3 P3 S1 /
              Pw Ph dx dy i j rez imz count TmpReZ TmpImZ absZ
              nclr nH nS nL nR nG nB HSL0 colRGB ncolor TH TS TL TR)
  (type_putpixel P3 colobj)
  (choose_distance R3)
  (choose_fun S1)
  (setq HSL0 (RGB->HSL (car col0) (cadr col0) (caddr col0)))
  (setq TH (atoi (nth 0 R2)))
  (setq TS (atoi (nth 1 R2)))
  (setq TL (atoi (nth 2 R2)))
  (setq TR (atoi (nth 3 R2)))
  (setq Pw (car J2) Ph (cadr J2))
  (setq dx (/ (- X2 X1) Pw))
  (setq dy (/ (- Y2 Y1) Ph))
  (setq i 0)
  (setq k 0)
  (repeat Pw
    (setq j 0)
    (repeat Ph
      (setq reZ (+ X1 (* i dx)))                                   ;迭代原点实部
      (setq imZ (+ Y1 (* j dy)))                                   ;迭代原点虚部
      (setq count 0)                                               ;计数器归零
      (while (<= count J1)                                         ;如果小于最大迭代次数
        ;;(setq TmpReZ (+ (* reZ reZ) (* imZ imZ -1) X0))          ;新的实部
        ;;(setq TmpImZ (+ (* 2 reZ imZ) Y0))                       ;新的虚部
        (setq tmprez (fx rez imz x0))
        (setq tmpimz (fy rez imz y0))       
        (setq absZ (dist TmpReZ TmpImZ))                           ;距离函数
        (if (> absZ J3)                                            ;如果距离大于逃逸半径
          (progn
            (setq nclr (* G1 count))                               ;渐变层次或函数
            (setq nH (rem (+ (* TH nclr) (car   HSL0)) 361))       ;色泽度渐变
            (setq nS (rem (+ (* TS nclr) (cadr  HSL0)) 101))       ;饱和度渐变
            (setq nL (rem (+ (* TL nclr) (caddr HSL0)) 101))       ;明暗度渐变
            (setq colRGB (HSL->RGB nH nS nL))                      ;色彩转换
            (setq nR (rem (+ (* TR nclr) (car   colRGB)) 256)      ;红蓝绿渐变
                  nG (rem (+ (* TR nclr) (cadr  colRGB)) 256)
                  nB (rem (+ (* TR nclr) (caddr colRGB)) 256)
                  colRGB (list nR nG nB)
            )
            (putpixel i j colRGB)                                      ;画像素点
            (setq count J1)                                        ;终止迭代
          )
          (setq rez TmpReZ imz TmpImZ)                             ;用新的迭代
        )
        (setq count (1+ count))
      )
      (setq j (1+ j))
    )
    (setq i (1+ i))
  )
)
;;;==========================
;;;Mandelbrot算法函数(带参数)
;;;==========================
(defun Mandelbrot (J1 J2 J3 X0 Y0 X1 Y1 X2 Y2 col0 G1 R2 R3 P3 S1 /  Pw Ph
                   dx dy i j rePart imPart rez imz absZ TmpReZ TmpImZ count
                   nclr nH nS nL nR nG nB HSL0 colRGB ncolor TH TS TL TR)
  (type_putpixel P3 colobj)
  (choose_distance R3)
  (choose_fun S1)
  (setq HSL0 (RGB->HSL (car col0) (cadr col0) (caddr col0)))
  (setq TH (atoi (nth 0 R2)))
  (setq TS (atoi (nth 1 R2)))
  (setq TL (atoi (nth 2 R2)))
  (setq TR (atoi (nth 3 R2)))
  (setq Pw (car J2) Ph (cadr J2))
  (setq dx (/ (- X2 X1) Pw))
  (setq dy (/ (- Y2 Y1) Ph))
  (setq i 0)
  (repeat Pw
    (setq j 0)
    (repeat Ph
      (setq rePart (+ X1 (* i dx)))                                ;实部
      (setq imPart (+ Y1 (* j dy)))                                ;虚部
      (setq reZ 0 imZ 0)                                           ;迭代原点(本可以取X0,Y0的)
      (setq count 0)
      (while (<= count J1)                                         ;如果小于最大迭代次数
        ;;(setq TmpReZ (+ (* reZ reZ) (* imZ imZ -1) rePart))      ;新的实部
        ;;(setq TmpImZ (+ (* 2 reZ imZ) imPart))                   ;新的虚部
        (setq tmprez (fx rez imz repart))
        (setq tmpimz (fy rez imz impart))
        (setq absZ (dist TmpReZ TmpImZ))                           ;距离函数
        (if (> absZ J3)                                            ;如果距离大于逃逸半径
          (progn                                                   ;则
            (setq nclr (* G1 count))                               ;渐变层次或函数
            (setq nH (rem (+ (* TH nclr) (car   HSL0)) 361))       ;色泽度渐变
            (setq nS (rem (+ (* TS nclr) (cadr  HSL0)) 101))       ;饱和度渐变
            (setq nL (rem (+ (* TL nclr) (caddr HSL0)) 101))       ;明暗度渐变
            (setq colRGB (HSL->RGB nH nS nL))                      ;色彩转换
            (setq nR (rem (+ (* TR nclr) (car   colRGB)) 256)      ;红蓝绿渐变
                  nG (rem (+ (* TR nclr) (cadr  colRGB)) 256)
                  nB (rem (+ (* TR nclr) (caddr colRGB)) 256)
                  colRGB (list nR nG nB)
            )
            (putpixel i j colRGB)                                      ;画像素点
            (setq count J1)                                        ;终止迭代
          )                                                        ;否则
          (setq rez TmpReZ imz TmpImZ)                             ;用新的迭代
        )
        (setq count (1+ count))
      )
      (setq j (1+ j))
    )
    (setq i (1+ i))
  )
)
;;;==========================
;;;逃逸函数(也可自己定义逃逸)
;;;==========================
(defun choose_distance (vv)
  (cond
    ;;标准逃逸
    ( (= vv "T3")           
      (defun dist (a b)
        (+ (* a a) (* b b))
      )
    )
    ;;X逃逸
    ( (= vv "T4")
      (defun dist (a b)
        (* a a)
      )
    )
    ;;Y逃逸
    ( (= vv "T5")
      (defun dist (a b)
        (* b b)
      )
    )
    ;;斑纹
    ( (= vv "T6")
      (defun dist (a b)
        (* a b)
      )
    )
    ;;自定义
    ( (= vv "T7")
      (defun dist (a b)
        (- (* a a) (* b b))
      )
    )
  )
)
;;;==========================
;;;复数迭代次方(越高时间越长)
;;;==========================
(defun choose_fun (nn)
  (cond
    ( (= nn "2")
      (defun FX (x y Cx0)
        (+ (* x x) (* y y -1) Cx0)
      )
      (defun FY (x y Cy0)
        (+ (* 2 x y) Cy0)
      )
    )
    ( (= nn "3")
      (defun FX (x y Cx0)
        (+ (* x x x)   (* -3 x y y) Cx0)
      )
      (defun FY (x y Cy0)
        (+ (* 3 x x y) (* -1 y y y) Cy0)
      )
    )
    ( (= nn "4")
      (defun FX (x y Cx0)
        (+ (* x x x x) (* -6 x x y y) (* y y y y) Cx0)
      )
      (defun FY (x y Cy0)
        (+ (* 4 x x x y) (* -4 x y y y) Cy0)
      )
    )
    ( (= nn "5")
      (defun FX (x y Cx0)
        (+ (* x x x x x) (* -10 x x x y y) (* 5 x y y y y) Cx0)
      )
      (defun FY (x y Cy0)
        (+ (* y y y y y) (* -10 x x y y y) (* 5 x x x x y) Cy0)
      )
    )
    ( (= nn "6")
      (defun FX (x y Cx0)
        (+ (* x x x x x x) (* -1 y y y y y y) (* -15 x x x x y y) (* 15 x x y y y y) Cx0)
      )
      (defun FY (x y Cy0)
        (+ (* 6 x x x x x y) (* -20 x x x y y y) (* 6 x y y y y y) Cy0)
      )
    )
  )
)
[/php]
[php]
;;;===============
;;;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)
  )
)
;;;=========================
;;;用entmake方法画像素点函数
;;;=========================
(defun type_putpixel (P3 colobj)
  (if (= P3 1)
    (defun putpixel (a b c / color)
      (setq color (RGB->Index colobj c))
      (fill_image a b 1 1 color)
    )
    (defun putpixel (a b c / color)
      (setq color (RGB->Number c))
      (entmake
        (list
          '(0 . "LWPOLYLINE")
          '(100 . "AcDbEntity")
          '(100 . "AcDbPolyline")
          '(90 . 2)
          '(43 . 1.0)
          (cons 420 color)
          (cons 10 (list a b))
          (cons 10 (list (1+ a) b))
        )
      )
    )
  )
)
;;;=========================
;;;随机函数(返回0-1的浮点值)
;;;=========================
(defun rnd (rMin rMax / )
  (vla-eval
    (vlax-get-acad-object)
    "Randomize : ThisDrawing.setVariable \"USERR5\" ,CDbl((Rnd))"
  )
  (if (= 'INT (type rmin) (type rmax))
    (fix (+ rMin (* (getvar "USERR5") (- rMax rMin -1))))
    (+ rMin (* (getvar "USERR5") (- rMax rMin)))
  )
)
;;;=========================
;;;列表中的字符串转化为列表
;;;=========================
(defun string->list (x)
  (while (Wcmatch x "*\n*")
    (setq x (vl-string-subst "\"\"" "\n" x))
  )
  (read (strcat "(\"" x "\")"))
)
[/php]

它山之石

这个已非常人所能
纯支持一下

snoopychen

刚好要学习dcl使用，得好好向highflybird兄学习一番了。不知道利用objectdcl的话会不会还能更简单些。