Grrr 发表于 2022-7-5 17:34:16

 
美好的
我刚刚写了一些关于和函数的类似内容:
(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))
)
李,你有什么想法吗?

Roy_043 发表于 2022-7-5 17:36:20

根据文档,(vl every)函数返回T或nil。

Grrr 发表于 2022-7-5 17:38:53

 
我尝试将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(为什么?-为什么不?)。

Lee Mac 发表于 2022-7-5 17:43:15

 
首先,请注意,为了使用此函数返回的值,变量赋值应在对“_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)
)

Grrr 发表于 2022-7-5 17:45:23

李,这似乎管用。我注意到它收集了所有非零评估,直到有一个零评估或列表结束:
_$ (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
 
非常感谢李!
每次我玩/尝试这个时,我都会尝试在代码中包含你的名字。

Lee Mac 发表于 2022-7-5 17:50:49

谢谢你发现了拼写错误!

rkent 发表于 2022-7-5 17:52:03

按下向上箭头键怎么样?

Grrr 发表于 2022-7-5 17:56:11

 
不用担心,李,
我非常感谢你的帮助!

Roy_043 发表于 2022-7-5 17:59:34

IMO更合理的做法是将Lee的“vl every”建议修改为:
21

halam 发表于 2022-7-5 18:02:00

它过去很管用,但我想知道什么时候以及为什么会出现在什么新的AutoCAD版本中?迷路了,我一直没能弄明白。是否有任何setvar控制箭头键行为??
页: 1 [2]
查看完整版本: 使用上一个输入