找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 963|回复: 1

[求助] 刚学,求教了

[复制链接]

已领礼包: 329个

财富等级: 日进斗金

发表于 2015-7-16 18:46:30 | 显示全部楼层 |阅读模式

马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。

您需要 登录 才可以下载或查看,没有账号?立即注册

×
(defun c:mytk (/)
  (setq cmdecho (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (command "_opendcl")
  (setvar "cmdecho" cmdecho)
  (setq dcl "d:\\odc\\mytk.odcl")
  (dcl_project_load dcl t)
  (dcl_form_show mytk_form)
  (princ)
)

(defun c:mytk_form_OnInitialize (/)
  (if (dcl_Form_Show dclid "Form1")
    (progn
      (setq mytk_path "d:\\std")
      (setq mytk_subpath (finddir tk_path))
      (dcl-ComboBox-addlist mytk_Form_ComboBox mytk_subpath)
      (setq sel (dcl_ComboBox_getlbtext mytk/form/combobox 1))
      (setq tk_file (strcat tk_path "\\" sel))
      ;;(dcl-listbox-addlist mytk/form/listbox newitems [as list of strings])
      (dcl_listbox_addlist mytk_form_listbox mytk_file)
      (dcl-Control-SetText mytk/Form/TextBox "3")
    )
  )

  (princ)
)
;;-------------------------------------------------------
;;
;;-------------------------------------------------------
;;
;;
(defun BrowseForFolder (msg / WinShell hwnd shFolder path catchit)
  (vl-load-com)
  (setq winshell (vlax-create-object "Shell.Application"))
  (setq hwnd (vlax-get-property (vlax-get-acad-object) 'Hwnd))
  (setq shFolder
  (vlax-invoke-method WinShell 'BrowseForFolder hwnd msg 1)
  )
  (setq
    catchit (vl-catch-all-apply
       '(lambda ()
   (setq shFolder (vlax-get-property shFolder 'self))
   (setq path (vlax-get-property shFolder 'path))
        )
     )
  )
  (if (vl-catch-all-error-p catchit)
    nil
    path
  )
)
(defun qf_getFolder (msg / WinShell shFolder path catchit)
  (vl-load-com)
  (setq winshell (vlax-create-object "Shell.Application"))
  (setq shFolder (vlax-invoke-method WinShell 'BrowseForFolder 0 msg 1))
  (setq catchit
  (vl-catch-all-apply
    '(lambda ()
       (setq shFolder (vlax-get-property shFolder 'self))
       (setq path (vlax-get-property shFolder 'path))
     )
  )
  )
  (if (vl-catch-all-error-p catchit)
    nil
    path
  )
)
(defun finddir (dir / dirname)
  (setq dirname (vl-directory-files dir nil -1))
  (if (= (car dirname) ".")
    (setq dirname (cdr dirname))
  )
  (if (= (car dirname) "..")
    (setq dirname (cdr dirname))
  )
  dirname
)
(defun finddwg (dir / fname pl str nalen npl x)
  (if (setq fname (vl-directory-files dir "*.dwg" 1))
    (progn
      (setq pl '())
      (foreach x fname
(setq nalen (strlen x))
(setq str (substr x 1 (- nalen 4)))
(setq npl (cons str npl))
      )
      (reverse npl)
    )
  )
)

mytk.odcl

1.98 KB, 下载次数: 2, 下载积分: D豆 -1 , 活跃度 1

论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!

已领礼包: 264个

财富等级: 日进斗金

发表于 2015-7-16 22:01:40 | 显示全部楼层
有啥问题?
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2024-5-29 15:13 , Processed in 0.248050 second(s), 33 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

快速回复 返回顶部 返回列表