Vlisp编程技巧摘要
作者：hqd9639  出处：晓东CAD  更新时间： 2004年10月17日 
;;;**********************************************************
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)))
    )

;;********************************************************
11.如何在CAD中插入时间和日期?
 Code:
(defun C:inttime()
   (setq pt0 (getpoint "\n请指定插入位置点 :"))
   (setq date0 (menucmd "M=$(edtime,$(getvar,date), DD.MM.YYYY hh:mm:ss)"))
   (command "text" "j" "m" pt0 5.0 0 date0)
   (princ)
)

;;********************************************************
12.如何用LISP打开WINDOWS的选择目录对话框?

   方法有5种:
   a.(setq bmpdir (xdrx_getdir "选择目录" "" "请选取目录" ))
   b.(dos_getdir "选择目录:" "c:\\")
   c.(setq picdir (Odcl_BrowseFolder "选取文件目录"  ""))
   d.(acet-ui-pickdir "选择目录" "" "请指定目录")
   e:
     Code:
(defun qf_getFolder (msg / WinShell shFolder path catchit)
  (vl-load-com)
  (setq winshell (vlax-create-object "Shell.Application"))
  (vlax-dump-object winshell T)
  (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
  )
)
 
 
 
 
 
 Vlisp编程技巧.txt