美好的
我刚刚写了一些关于和函数的类似内容:
(defun _and ( lst / r rtn )
(not (vl-some '(lambda ( x ) (or (vl-catch-all-error-p (setq r (vl-catch-all-apply 'eval (list x)))) (not r))) lst))
(setq rtn (cons r rtn))
(reverse rtn)
)
(defun _and ( lst )
(vl-every '(lambda ( x / r ) (if (not (vl-catch-all-error-p (setq r (vl-catch-all-apply 'eval (list x))))) r)) lst)
)
(if (setq p (_and '((getpoint "\n1st try: ") (getpoint "\n2nd try: ") (getpoint "\n3rd try: "))))
p
)
虽然性能和返回与and函数相同,但我希望不是T,而是得到一个评估列表的返回,因此可以这样合并:
(if
(_and
(setq lst
'(
(getpoint "\nSpecify circle's center: ")
(getpoint "\nSpecify second point for radius: ")
)
)
)
(command "_.CIRCLE" "_non" (car lst) "_non" (cadr lst))
)
李,你有什么想法吗? 根据文档,(vl every)函数返回T或nil。
我尝试将catch apply函数的结果收集到单独的列表中,以便返回结果,但这会影响整体性能,因此我得到的最接近的结果是:
(defun MakeInputLst ( key func arglst mainALst / mainALst expr )
(if
(and
(= 'STR (type key)) (= 'SUBR (type func)) (listp arglst) (listp mainALst)
(not (vl-catch-all-error-p (setq expr (vl-catch-all-apply 'func arglst))))
)
(setq mainALst (cons (cons key expr) mainALst))
); if
mainALst
);| defun MakeInputLst |; (or vlax-get-acad-object (vl-load-com)) (princ)
(and
(not (setq InputList (list)))
(apply 'and (mapcar 'cdr (setq InputList (MakeInputLst "FirstPt"getpoint (list "\nSpecify first point: ") InputList))))
(apply 'and (mapcar 'cdr (setq InputList (MakeInputLst "SecondPt" getpoint (list "\nSpecify second point: ") InputList))))
(apply 'and (mapcar 'cdr (setq InputList (MakeInputLst "ThirdPt" getpoint (list "\nSpecify third point: ") InputList))))
(apply 'and (mapcar 'cdr (setq InputList (MakeInputLst "ent" entsel (list "\nSelect an entity to get its layer: ") InputList))))
(mapcar
'(lambda (x)
(and
(member (car x) '("FirstPt" "SecondPt" "ThirdPt"))
(entmakex (list (cons 0 "POINT") (assoc 8 (entget (car (cdr (assoc "ent" InputList))))) (cons 10 (cdr x))))
)
)
InputList
)
); and
我认为有一个更简单的方法。也许我会为此创建一个新的线程,因为OP的任务已经解决,我把这个问题重定向得太多了。
但正如你所见,我们的想法是跳过任何额外的setq,而是处理一个assoc列表,其中每个点对代表一个setq(为什么?-为什么不?)。
首先,请注意,为了使用此函数返回的值,变量赋值应在对“_and”函数求值后进行求值:
对于“和”函数,有许多可能性:
(defun _and ( lst / rtn )
(vl-every '(lambda ( x ) (if (setq x (catcheval x)) (setq rtn (cons x rtn)))) lst)
(reverse rtn)
)
(defun _and ( lst / val )
(if (and lst (setq val (catcheval (car lst)))) (cons val (_and (cdr lst))))
)
(defun _and ( lst / rtn val )
(while (and lst (setq val (catcheval (car lst))))
(setq rtn (cons val rtn)
lst (cdr lst)
)
)
(reverse rtn)
)
(defun catcheval ( x / r )
(if (not (vl-catch-all-error-p (setq r (vl-catch-all-apply 'eval (list x))))) r)
)修订:
(defun _and ( lst / rtn )
(if (vl-every '(lambda ( x ) (if (setq x (catcheval x)) (setq rtn (cons x rtn)))) lst)
(reverse rtn)
)
)
(defun _and ( lst / foo )
(defun foo ( lst acc / val )
(if lst
(if (setq val (catcheval (car lst)))
(foo (cdr lst) (cons val acc))
)
(reverse acc)
)
)
(foo lst nil)
)
(defun _and ( lst / rtn val )
(while (and lst (setq val (catcheval (car lst))))
(setq rtn (cons val rtn)
lst (cdr lst)
)
)
(if (null lst) (reverse rtn))
)
(defun catcheval ( x / r )
(if (not (vl-catch-all-error-p (setq r (vl-catch-all-apply 'eval (list x))))) r)
) 李,这似乎管用。我注意到它收集了所有非零评估,直到有一个零评估或列表结束:
_$ (setq pts (_and '((getpoint "\n1st try: ") (getpoint "\n2nd try: ") (getpoint "\n3rd try: "))))
nil ; hit enter (no points specified)
_$ (setq pts (_and '((getpoint "\n1st try: ") (getpoint "\n2nd try: ") (getpoint "\n3rd try: "))))
((140.658 116.678 0.0)) ; first point specified, then pressed enter
_$ (setq pts (_and '((getpoint "\n1st try: ") (getpoint "\n2nd try: ") (getpoint "\n3rd try: "))))
((140.658 116.678 0.0) (156.932 167.24 0.0)) ; first and second point specified, then pressed enter
_$ (setq pts (_and '((getpoint "\n1st try: ") (getpoint "\n2nd try: ") (getpoint "\n3rd try: "))))
((94.3117 156.279 0.0) (101.034 182.797 0.0) (188.065 174.665 0.0)) ; all points specified
_$
因此,通过比较列表的长度,可以确定提示的所有内容是否都是非零值,因此代码继续:
(defun C:test ( / lst )
(if
(=
(length (setq lst '( (getpoint "\nFirst point: ") (getpoint "\nSecond point: "))))
(length (setq lst (_and lst)))
)
(command "_.LINE" "_non" (car lst) "_non" (cadr lst) "")
)
(princ)
)
我注意到了一个小问题:
20
非常感谢李!
每次我玩/尝试这个时,我都会尝试在代码中包含你的名字。 谢谢你发现了拼写错误! 按下向上箭头键怎么样?
不用担心,李,
我非常感谢你的帮助! IMO更合理的做法是将Lee的“vl every”建议修改为:
21 它过去很管用,但我想知道什么时候以及为什么会出现在什么新的AutoCAD版本中?迷路了,我一直没能弄明白。是否有任何setvar控制箭头键行为??
页:
1
[2]