yxp 发表于 2013-4-5 18:51:40

Opendcl 控件入门练习 [源码]


刚刚入手学习opendcl请各位大虾指点

;;加载lsp时自动加载OpenDCL.xx.arx链接库arx函数
(or dcl_getversionex (progn
(defun Load:Runtime ( / acadversion arxname dclarxfile)
   (defun *error* (msg) (princ (strcat "\n 加载失败，找不到" arxname "文件,请确认该文件是否在搜索路径")))
   (setq acadversion (substr (getvar "acadver") 1 2))
   (setq arxname (strcat "OpenDCL." acadversion ".arx"))
   (setq dclarxfile (findfile arxname))
   (if (and (= (member arxname (arx) ) nil) (/= dclarxfile nil))
      (arxload dclarxfile) (exit))
) (Load:Runtime))
)
;;主程序
(defun c:sld()
   (dcl_Project_Load "sld.odcl")
   (dcl_Form_Show sld_form1)
   (dcl_Project_Unload "sld")
)
;;读入dwg图形BlockView
(defun c:sld_Form1_TextButton2_Clicked (/ ss)
(setq ss (GetFiled "打开文件" "" "dwg" 4))
(and ss (dcl_BlockView_LoadDwg sld_Form1_BlockView1 ss)
         (dcl_Control_SetFocus sld_form1_BlockView1)
   (dcl_Control_SetCaption sld_Form1_Label6 ss))
)

;;画线PictureBox
(defun c:sld_Form1_TextButton1_OnClicked (/)
   (setq a1 (list (atoi (dcl_Control_GetText sld_Form1_TextBox1))
                (atoi (dcl_Control_GetText sld_Form1_TextBox2))
       (atoi (dcl_Control_GetText sld_Form1_TextBox6))
       (atoi (dcl_Control_GetText sld_Form1_TextBox7))
          (atoi (dcl_Control_GetText sld_Form1_TextBox5))
))
(dcl_PictureBox_DrawLine sld_Form1_PictureBox1 (list a1))
)

;;显示幻灯片
(defun c:sld_Form1_TextButton3_OnClicked (/)
(setq ss (GetFiled "打开文件" "" "sld" 4))
(if ss (dcl_SlideView_Load sld_Form1_SlideView1 ss)
    (dcl_MessageBox "提示\r\r\n未读入幻灯片" "提示" 2 3))
)

;;填充SlideView
(defun c:sld_Form1_TextButton4_OnClicked (/)
    (setq a1 (list (atoi (dcl_Control_GetText sld_Form1_TextBox1))
               (atoi (dcl_Control_GetText sld_Form1_TextBox2))
         (atoi (dcl_Control_GetText sld_Form1_TextBox3))
         (atoi (dcl_Control_GetText sld_Form1_TextBox4))
          (atoi (dcl_Control_GetText sld_Form1_TextBox5))
))
(dcl_SlideView_FillImage sld_form1_SlideView1 (list a1))
)

;;清除控件
(defun c:sld_Form1_TextButton5_OnClicked (/)
(dcl_SlideView_Clear sld_Form1_SlideView1)
(dcl_BlockView_Clear sld_Form1_BlockView1)
(dcl_PictureBox_Clear sld_Form1_PictureBox1)
)







yxp 发表于 2013-4-5 18:58:05

以上基于CAD2004调试，相关arx支持文件下载地址
http://bbs.mjtd.com/thread-100560-1-1.html

zyhandw 发表于 2013-4-25 14:45:58

经试用，效果不错，向你学习

alwtyp 发表于 2013-6-22 17:59:17

请把64位系统的CAD考虑进去

jyzas 发表于 2013-7-28 20:20:23

不错，下载来学习

tender138 发表于 2017-12-1 08:59:29

想不顶你都难！就凭你无私的人格！

894560869 发表于 2018-7-7 04:37:34

本帖最后由 894560869 于 2018-7-7 04:38 编辑

仰慕，感谢分享

疯球 发表于 2018-8-14 14:07:15

谢谢楼主的分享

liwen888888 发表于 2021-7-16 21:38:12

楼主，你的这个代码好像没有考虑64位系统，格式为OPENDCL.X64.CAD版本。arx,会出现64位系统加载失败。找不到" arxname "文件
;;加载lsp时自动加载OpenDCL.xx.arx链接库arx函数
(or dcl_getversionex (progn
(defun Load:Runtime ( / acadversion arxname dclarxfile)
   (defun *error* (msg) (princ (strcat "\n 加载失败，找不到" arxname "文件,请确认该文件是否在搜索路径")))
   (setq acadversion (substr (getvar "acadver") 1 2))
   (setq arxname (strcat "OpenDCL." acadversion ".arx"))
   (setq dclarxfile (findfile arxname))
   (if (and (= (member arxname (arx) ) nil) (/= dclarxfile nil))
      (arxload dclarxfile) (exit))
) (Load:Runtime))
)

1028882406@qq.c 发表于 2022-5-2 12:25:46

谢谢版主分享
页: [1]
查看完整版本: Opendcl 控件入门练习 [源码]