代码改变世界

AutoLISP图像控件Image应用示例

2011-05-20 19:05  精诚所至 金石为开  阅读(1436)  评论(0编辑  收藏  举报

DCL对话框文件代码如下。

dia8a:dialog {
    label = "图像设计示例" ;
    :row {
        :boxed_radio_column {
            label = "设计样式" ;
            :radio_button {
                key = "rb1" ;
                label = "L基本型" ;
            }
            :radio_button {
                key = "rb2" ;
                label = "L圆形" ;
            }
            :radio_button {
                key = "rb3" ;
                label = "L双圆形" ;
            }
            :radio_button {
                key = "rb4" ;
                label = "L弧形" ;
            }
        }
        :image {
            aspect_ratio = 0.66 ;
            color = -2 ;
            key = "kimage" ;
            width = 30 ;
        }
    }
    :row {
        :edit_box {
            key = "kww" ;
            label = "宽度WW" ;
        }
        :edit_box {
            key = "khh" ;
            label = "高度HH" ;
        }
    }
    spacer_1;
    ok_cancel;
}

LISP文件代码如下。

(defun c:dia8a ()
    (setvar "cmdecho" 0)
    (dcl_dia8a)
    (prin1)
)
(defun dcl_dia8a ()
    (setq dcl_id (load_dialog "dia8a"))
    (new_dialog "dia8a" dcl_id)
    (sub_rb1)
    (set_tile "rb1" "1")
    (set_tile "kww" "100")
    (set_tile "khh" "100")
    (action_tile "rb1" "(sub_rb1)")
    (action_tile "rb2" "(sub_rb2)")
    (action_tile "rb3" "(sub_rb3)")
    (action_tile "rb4" "(sub_rb4)")
    (action_tile "accept" "(ok_dia8a) (done_dialog 1)")
    (setq dd (start_dialog))
    (if    (= dd 1)
    (draw_dia8a)
    )
)
(defun sub_rb1 ()
    (setq ddtype 1)
    (show_sld "kimage" "dia8a1")
)
(defun sub_rb2 ()
    (setq ddtype 2)
    (show_sld "kimage" "dia8a2")
)
(defun sub_rb3 ()
    (setq ddtype 3)
    (show_sld "kimage" "dia8a3")
)
(defun sub_rb4 ()
    (setq ddtype 4)
    (show_sld "kimage" "dia8a4")
)
(defun show_sld    (key sld)
    (setq x (dimx_tile key))
    (setq y (dimy_tile key))
    (start_image key)
    (fill_image 0 0 x y -2)
    (slide_image 0 0 x y sld)
    (end_image)
)
(defun ok_dia8a    ()
    (setq ww (atof (get_tile "kww")))
    (setq hh (atof (get_tile "khh")))
)
(defun draw_dia8a ()
    (setq pt1 (getpoint "左下角基准点:"))
    (setq pt2 (Polar pt1 0 ww))
    (setq pt3 (polar pt2 (/ pi 2) hh))
    (setq pt4 (polar pt3 pi (* ww 0.5)))
    (setq pt5 (polar pt4 (* pi 1.5) (* hh 0.5)))
    (setq pt6 (polar pt5 pi (* ww 0.5)))
    (cond ((= ddtype 1) (command "pline" pt1 pt2 pt3 pt4 pt5 pt6 "c"))
      ((= ddtype 2)
       (command "pline" pt6 pt1 pt2 pt3 pt4 "")
       (command "circle" "2p" pt4 pt6)
      )
      ((= ddtype 3)
       (command "pline" pt1 pt2 pt3 "")
       (command "pline" pt4 pt5 pt6 "")
       (command "circle" "2p" pt3 pt4)
       (command "circle" "2p" pt6 pt1)
      )
      ((= ddtype 4)
       (command "pline" pt1 pt2 pt3 pt4 "a" "a" -180 pt6 "L" "C")
      )
    )
)

代码完。

最近忙着弄触摸屏和PLC,没空学LISP了。