OpenDCL对话框设计-Grid控件设计教学演示。。。

XDSoft

晓东工具箱下的按图层统计填充面积工具，主要就是使用的Grid控件。


不多说，先上视频。

如果无法播放，请点击此处在新窗口打开

XDSoft

1、OnIntalize 事件处理函数

[pcode=lisp,true]
  (defun c:HatchAreaForm_OnInitialize (/)
    (setq layall ($xdob_layer_getalllayer)          ;;获得当前图形所有层信息
          layon ($xdob_layer_getallonlayer)       ;;获得所有可见层信息
    )
    (if (not $xdtb_global_hatcharea_var)   ;;预置对话框控件状态，恢复上次运行状态。
      (setq $xdtb_global_hatcharea_var (list '("JSFS" 0) '("UNITS" 0) '("JD" 1) '("CHECKALL" 1) '("ZEROCHECKBOX" 0)))
    )
    (setq JSFS (cadr (assoc "JSFS" $xdtb_global_hatcharea_var))   ;;计算各层填充面积
          UNITS (cadr (assoc "UNITS" $xdtb_global_hatcharea_var)) ;;显示精度
          JD (cadr (assoc "JD" $xdtb_global_hatcharea_var))
          CHECKALLBOX (cadr (assoc "CHECKALL" $xdtb_global_hatcharea_var))
          ZEROCHECKbox (cadr (assoc "ZEROCHECKBOX" $xdtb_global_hatcharea_var))
    )
    (cond
      ((= UNITS 0)
        (setq js_UNITS 1)
      )
      ((= UNITS 1)
        (setq js_UNITS 10000)
      )
      ((= UNITS 2)
        (setq js_UNITS 666.66667)
      )
    )
    (dcl_Control_SetValue CheckAll CHECKALLBOX)
    (dcl_OptionList_SetCurSel TypeJS JSFS)
    (dcl_ComboBox_SetCurSel HatchJD JD)
    (dcl_ComboBox_SetCurSel AREAUNITS UNITS)
    (dcl_Control_SetValue ZEROCHECK ZEROCHECKbox)
    (if (= JSFS 0)
      (progn
        (Grid_Display Grid_DataON)
        (setq Grid_Curent_Items Grid_DataON)
      )
      (progn
        (Grid_Display Grid_DataALL)  ;;对Grid控件操作显示表格数据
        (setq Grid_Curent_Items Grid_DataALL)
      )
    )
    (if (= (length Grid_DataAll) (length Grid_DataOn))
      (progn
        (dcl_OptionList_SetCurSel TypeJS 1)  ;;根据图层数据，设置一些控件的可用性。有关闭层的时候，可见层控件可选
        (dcl_Control_SetEnabled TypeJS nil)
      )
    )
  )
[/pcode]


2、Grid 控件的处理函数

       这段代码可以稍加修改，就能用于您的程序。

[pcode=lisp,true](defun Grid_Display (val)  (dcl_Grid_Clear HatchArea_Grid)      ; 清空Grid
  (setq i 1)
  (setq TotalVal1 0)
  (foreach n val
    (if (= ZEROCHECKbox 1)
      (progn
        (if (/= (caddr n) 0.0)
          (progn
            (setq intRow
                  (dcl_Grid_AddString HatchArea_Grid
                                      (strcat
                                              (itoa i) "\t \t"
                                              (car n)
                                              "\t"
                                              (cadr n)
                                              "\t"
                                              (setq val1
                                                    ($xdlsp_string_format
                                                                          (/
                                                                             (caddr n) js_UNITS
                                                                          ) JD
                                                    )
                                              )
                                      )
                  )
            )
            (dcl_Grid_SetCellCheckState HatchArea_Grid
                                        intRow 1 1
            )
            (setq TotalVal1 (+ TotalVal1
                               (atof val1)
                            )
            )
            (setq i (1+ i))
          )
        )
      )
      (progn
        (setq intRow (dcl_Grid_AddString HatchArea_Grid
                                         (strcat
                                                 (itoa i) "\t \t"
                                                 (car n) "\t"
                                                 (cadr n) "\t"
                                                 (setq val1
                                                       ($xdlsp_string_format
                                                                             (/
                                                                                (caddr n) js_UNITS
                                                                             ) JD
                                                       )
                                                 )
                                         )
                     )
        )
        (dcl_Grid_SetCellCheckState HatchArea_Grid
                                    intRow 1 1
        )
        (setq TotalVal1 (+ TotalVal1 (atof val1)))
        (setq i (1+ i))
      )
    )
  )
  (dcl_Control_SetCaption TotalVal
                          ($xdlsp_string_format TotalVal1
                                                JD
                          )
  )
  (dcl_Control_SetCaption TotalUnit
                          (dcl_ComboBox_GetEBText AREAUNITS)
  )
  (dcl_Control_SetFontBold TotalVal t)
)
[/pcode]


2、获得填充面积相关函数

[pcode=lisp,true]
(defun $get_Grid_Data (lay / carea datal e i n ss)
    (acet-ui-progress "数据采集中" (length lay))
    (setq l 0)
    (foreach n lay
      (acet-ui-progress l)
      (if (setq ss (ssget "x" (list (cons 8 n) (cons 0 "HATCH"))))
        (progn
          (setq carea (car (xdrx_getarea ss))
                i (sslength ss)
          )
          (setq datal (cons (list n (itoa i) carea) datal))
        )
        (progn
          (setq datal (cons (list n "0" 0.0) datal))
        )
      )
      (setq l (1+ l))
    )
    (acet-ui-progress)
    (setq datal (reverse datal))
    (setq Grid_Curent_Items datal)
  )
[/pcode]

xyp1964

坐等

yx5277

开源的？真不错啊:)

dwg001

精彩继续。。。

炫翔

{:soso_e179:}，很赞，支持！谢谢分享

panziyang000

XD大大，为什么视频看不了，能在发下吗

XDSoft

panziyang000 发表于 2013-5-27 08:58
XD大大，为什么视频看不了，能在发下吗

以前制作的SWF由于软件没激活，到期了。

重新传了演示，看看吧，欢迎常来！

龙泽天涯

好东西，有启发，能不能把odcl也发出来啊。