Vlisp编程技巧摘要

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
)
)

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