[LISP程序]：很實用的十個小程序

clyuyu

1.如何获取多义线上的所有顶点
2.在对话框的文本栏里输入，怎样让它实时显示为密码“ * ”  ？
3.怎样可以实现不用工具中的选项，来调出屏幕菜单？
4.怎么样用Vlisp来读取AutoCAD中搜索路径?
5.如何捕获列表框（list_box）的双击操作?
6.如何用VLISP创建目录？
7.如何用(entsel)亮显选择物体?
8.如何隐藏选择实体?
9.状态栏进度条的设计示例
10. 如何用VLISP获取所有配置文件(Profiles)列表?
1.如何获取多义线上的所有顶点
  Code:
  (defun C:getp (/ ent PLTYPE obj vtx vtxlst n ptlst)
    (vl-load-com)
    (setq ent (entsel "\n选取多线:\n"))
    (if ent
        (progn
          (setq PLTYPE (cdr (assoc 0 (entget (car ent)))))
          (if (or (= "POLYLINE" PLTYPE) (= "LWPOLYLINE" PLTYPE))
              (progn
                 (setq obj (vlax-ename->vla-object (car ent)))
                 (setq vtx (vla-get-Coordinates obj))
                 (setq vtxlst (vlax-safearray->list (vlax-variant-value vtx)))
                 (setq n 0)
                 (setq ptlst nil)
                 (repeat (/ (length vtxlst) 2)
                         (setq ptlst (append ptlst (list (list (nth n vtxlst) (nth (1+ n) vtxlst)))))
                         (setq n (+ n 2))
                 )
                 (if ptlst ptlst nil)
             )
             (prompt "\n选取实体不是多义线!")
          );if
       )      
     );if
  )
;;;**********************************************************

2.在对话框的文本栏里输入，怎样让它实时显示为密码“ * ”  ？
   A.设计对话框时，控件的属性中加：password_char = "*";
    srt : dialog {
        label = "密码" ;
        : edit_box {
          label = "输入密码(&S):";
          key = "password";
          password_char = "*";
          fixed_width = true;
          width = 8;
        }
        ok_only;
    }
(defun c:srt ( )
(setq filename "srt.dcl")
(if (> (setq index_value (load_dialog filename)) 0)           ;装载对话框
        (progn
           (setq dlgname "srt")
           (if (not (new_dialog dlgname index_value)) (exit))  ;显视对话框                  
           (action_tile "password" "(mypass)")  
           (action_tile "ok" "(done_dialog 0)")
           (start_dialog)

        )
        (alert "\n不能载装指定的DCL文件定义的对话框!")
);;;END IF
  (princ)
)
(defun mypass ()
   (setq a1 $value)  
)
  B.使用DOSLib输入密码的函数
;;;************************************



3.怎样可以实现不用工具中的选项，来调出屏幕菜单？
   
;;屏幕菜单切换
(defun C:pmmenu ()
  (vl-load-com)
  (setq sd
  (vla-get-display
    (vla-get-preferences (vlax-get-acad-object))
  )
  )
  (if (= (vla-get-displayscreenmenu sd) :vlax-true)
    (vla-put-displayscreenmenu sd :vlax-false)
    (vla-put-displayscreenmenu sd :vlax-true)
  )
  (vlax-release-object sd)
  (princ)
)
;;********************************************************


4.怎么样用Vlisp来读取AutoCAD中搜索路径?
  (vla-get-supportpath (vla-get-files (vla-get-preferences (vlax-get-acad-object))))
   或：
  (getenv "ACAD")
   或：
  (acet-pref-supportpath-list)获取支持路径。
;;***************************************************


5.如何捕获列表框（list_box）的双击操作?

在edit_box,list_box,image_button,slider中，有一个$reason变量，用来
表示你执行了什么操作 。在list_box中，双击的变量值是4。
可在你的代码中加入判断：
(action_tile "listbox" "(fun1).....")
(defun fun1()
   .....
(if (= $reason 4)
  .....
)
  .....
)

;;********************************************************

6.如何用VLISP创建目录？
   例如：
   A. (vl-mkdir "c:\\hqd9639")

   B. (setq SYS (vlax-create-object "Scripting.FileSystemObject"))
      (setq FOLDER (vlax-invoke-method SYS 'CREATEFOLDER "c:\\hqd9639"))

;;********************************************************




7.如何用(entsel)亮显选择物体?
   code:
   (if (setq ent (entsel "\nPick Object"))
       (progn
          (redraw (car ent) 3)
          ;;(redraw (car ent) 4);;;不亮显
      )
  )
;;********************************************************


8.如何隐藏选择实体?
   code:
   (if (setq ent (entsel "\nPick Object"))
       (progn
          (redraw (car ent) 1);;;隐藏实体
        ;;(redraw (car ent) 2);;;显示实体
      )
  )
;;********************************************************


9.状态栏进度条的设计示例

(defun c:hqd1 ()
   (acet-ui-progress "已经完成" 100)
   (setq x 0)
   (while (< x 100)
          (princ (strcat "\n" (itoa x)))
          (acet-ui-progress -1)
          (setq x (1+ x))
   )
   (acet-ui-progress)
)

;;********************************************************

10. 如何用VLISP获取所有配置文件(Profiles)列表?
  code:
    (defun c:getAllProfiles ()
      (setq a (vla-get-profiles (vla-get-preferences (vlax-get-acad-object))))
      (vla-GetAllProfileNames a 'hqd)
      (if hqd (setq lst (vlax-SafeArray->List hqd)))
    )

;;********************************************************

tang32

看不懂！

aneng

看不懂

shuaier

第一个程序稍微实用点,其它的一般,我是用不上!

倚夕扇雪

非常宝贵的经验，谢谢！

suruijie

最好是搞点通俗易懂的

dhxqqq

实用性不是太强，不过还是谢谢提供。

floyd007

有没有VBA版的？

az98hxq

非常有用的东东
我喜欢

zqb05

呵呵
下载试试

金鹅起飞

谢谢楼主分享源码，支持您！

jyzas

不错，收藏着，谢谢楼主分享

编程小白

很好，很实用！！！！！！