[原创]这些lisp函数对你可能有用！
;;交点列表(defun yad_inters(ss / n n1 obj1 n2 obj2 ipt l_pt)
(setq n (sslength ss)
n1 0
)
(while (< n1 (1- n))
(setq obj1 (vlax-ename->vla-object (ssname ss n1))
n2 (1+ n1)
)
(while (< n2 n)
(setq obj2 (vlax-ename->vla-object (ssname ss n2))
ipt(vlax-variant-value (vla-intersectwith obj1 obj2 0))
)
(if (> (vlax-safearray-get-u-bound ipt 1) 0)
(progn
(setq ipt (vlax-safearray->list ipt))
(while (> (length ipt) 0)
(setq l_pt (cons (list (car ipt) (cadr ipt) (caddr ipt)) l_pt) ipt (cdddr ipt))
)
)
)
(setq n2 (1+ n2))
)
(setq n1 (1+ n1))
)
l_pt
)
;;复合线顶点列表
(defun yad_ptlst(en / n l_pt l_p)
(if (not (listp en)) (setq en (entget en)))
(setq n (vl-position (assoc 10 en) en))
(repeat (- (length en) n)
(if (= (car (nth n en)) 10)
(setq l_pt (append l_pt (list (cdr (nth n en)))))
)
(setq n (1+ n))
)
(foreach n l_pt
(if (not (vl-member-if '(lambda(x) (equal x n 0.01)) l_p))
(setq l_p (append l_p (list n)))
)
)
l_p
)
;;复合线转折点列表
(defun yad_cptlst(l_pt / l_pv p1 p2 ang ang1 n p pd)
(setq l_pt (append l_pt (list (car l_pt)))
l_pv (list (setq p1 (nth 0 l_pt)) (setq p2 (nth 1 l_pt)))
ang (angle p1 p2)
ang1 ang
n 2
)
(while (setq p (nth n l_pt))
(setq pd p2)
(if (equal ang (angle p2 p) 0.01)
(setq l_pv (subst p p2 l_pv)
p2 p
)
(setq ang (angle p2 p)
p2 p
l_pv (append l_pv (list p))
)
)
(setq n (1+ n))
)
(if (equal ang1 (angle pd p2) 0.01)
(setq l_pv (vl-remove p2 l_pv))
(setq l_pv (reverse (cdr (reverse l_pv))))
)
l_pv
)
;;求屏幕两对角点
(defun yad_viewpt(/ a b c d x)
(setq b (getvar "viewsize")
c (car (getvar "screensize"))
d (cadr (getvar "screensize"))
a (* b (/ c d))
x (trans (getvar "viewctr") 1 2)
c (trans (list (- (car x)(/ a 2.0)) (- (cadr x) (/ b 2.0)) 0.0) 2 1)
d (trans (list (+ (car x) (/ a 2.0)) (+ (cadr x) (/ b 2.0)) 0.0) 2 1)
)
(list c d)
)
;;生成无名组
(defun yad_group(lst / en1 name en ent)
(setq lst (mapcar '(lambda(e) (cons 340 e)) lst))
(setq en1 (dictsearch (namedobjdict) "ACAD_GROUP"))
(if (member (cons 3 "*A1") en1)
(setq name (strcat "*A" (itoa (1+ (atoi (substr (cdr (assoc 3 (reverse en1))) 3))))))
(setq name "*A1")
)
(setq en (list (cons 0 "GROUP") (cons 102 "{ACAD_REACTORS")
(cons 330 (dxf en1 -1)) (cons 102 "}")
(cons 100 "AcDbGroup") (cons 70 1) (cons 71 1)
)
)
(setq ent (entmakex (append en lst))
en1 (append en1 (list (cons 3 name) (cons 350 ent)))
)
(entmod en1)
)
;;缩放屏幕确保对象在屏幕内
(defun yad_zoom(lst / maxmin lsttrans a b zmpt)
(defun maxmin(lst / x n a b c d)
(setq x (car lst)
a (car x)
b (cadr x)
c (car x)
d (cadr x)
n 1
)
(repeat (max (- (length lst) 1) 0)
(setq x (nth n lst)
a (min a (car x))
b (min b (cadr x))
c (max c (car x))
d (max d (cadr x))
n (1+ n)
)
)
(list (list a b) (list c d))
)
(defun lsttrans(lst a b / lst2 c n)
(setq n 0)
(repeat (length lst)
(setq c (trans (nth n lst) a b)
lst2 (append lst2 (list c))
n (1+ n)
)
)
lst2
)
(setq lst (maxmin (lsttrans lst 1 2))
a (car lst)
b (cadr lst)
lst (list (list (- (car a) 4000) (- (cadr a) 4000)) (list (+ (car b) 4000) (+ (cadr b) 4000)))
a (maxmin (lsttrans (viewpnts) 1 2))
b (maxmin (append a lst))
zmpt (list (trans (append (car b) '(0.0)) 2 1) (trans (append (cadr b) '(0.0)) 2 1))
)
(command "_.zoom" "_w" (car zmpt) (cadr zmpt))
zmpt
)
;;检查对话框输入数值的合法性
(defun yad_chkval(title maxint minint oldval / val)
(setq val (atof (get_tile title)))
(if (>= maxint val minint)
(set_tile title (rtos val))
(set_tile title oldval)
)
)
;;检查整数输入的合法性
(defun yad_chkint(pmt defval maxint minint / val pd)
(if (/= defval "no") (setq pmt (strcat pmt "<" defval ">") defval (atoi defval)))
(setq pd T)
(while (and pd (setq val (getint pmt)))
(if (>= maxint val minint)
(setq pd nil val val)
(prompt "输入无效！")
)
)
(if (and (/= defval "no") (not val)) (setq val defval))
(if (>= maxint val minint)
val
(if (/= defval "no")
(prompt "\n缺省值无效！")
)
)
)
;;选择集合并
(defun yad_ssadd(oldss ss / n)
(setq n -1)
(repeat (sslength ss)
(ssadd (ssname ss (setq n (1+ n))) oldss)
)
oldss
)
;;选择点特征的对象
(defun yad_ssget(dis x y z / n m)
(setq z (append z '((-4 . "<or"))))
(setq n 0)
(repeat (length x)
(setq m 0)
(repeat (length y)
(setq z (append z (list(cons -4 "<and")
(cons -4 "<=,<=")
(cons (nth n x)
(mapcar '(lambda(e) (+ e dis)) (nth m y))
)
(cons -4 ">=,>=")
(cons (nth n x)
(mapcar '(lambda(e) (- e dis)) (nth m y))
)
(cons -4 "and>")
)
)
)
(setq m (1+ m))
)
(setq n (1+ n))
)
(setq z (append z '((-4 . "or>"))))
(ssget "x" z)
)
;;修改对象
(defun yad_chgent(en n new)
(if (not (listp en)) (setq en (entget en)))
(if (assoc n en)
(setq en (subst (cons n new) (assoc n en) en))
(setq en (append en (list (cons n new))))
)
(entmod en)
)
;;删除表的指定位置项
(defun yad_remove(nm lst / n newlst)
(setq n 0)
(repeat (length lst)
(if (/= nm n)
(setq newlst (append newlst (list (nth n lst))))
)
(setq n (1+ n))
)
newlst
)
;;字符串转列表
(defun yad_str2lst(str st / lst)
(setq str (strcat str st))
(while (vl-string-search st str)
(setq lst (append lst (list (substr str 1 (vl-string-search st str)))))
(setq str (substr str (+ (1+ (strlen st)) (vl-string-search st str))))
)
(if lst (mapcar '(lambda(e) (vl-string-trim " " e)) lst))
)
;;直接使用ACAD命令
(defun yad_comd()
(setvar "cmdecho" 1)
(while (/= 0 (getvar "cmdactive")) (command pause))
(setvar "cmdecho" 0)
) 感谢分享！是需要逐个消化的！在运用中领悟！ ;;
;;yad_comd函数的使用例子
;;
(if (setq p1 (getpoint "\n请点取建筑轮廓线的起点："))
(progn
(setvar "cmdecho" 1)
(command "_.pline" p1 "_w" "50" "")
(prompt "\n使用 PLINE命令继续绘制建筑轮廓线！")
(yad_comd);;试试没有这个函数会怎么样
(alert "test ok!")
;;可增加后续代码
)
) 能不能把它的用途说的详细点？
谢谢。 继续努力 怎么用啊？ 强哦,真的高手太多,让我这种菜鸟人物有点进步 <p>有了这些函数就方便多了。谢谢楼主</p> 看不懂。顶一下 <p>眼花缭乱</p> 眼睛都卡不清楚东西了