社区 › Auto Lisp › “交换”lisp不'；t工作

Diedesigner 发表于 2022-7-6 11:12:13

“交换”lisp不'；t工作

大家好，
 
我从LukewarmCoffee网站下载了这个lisp——它是杰夫·雷霍恩（JeffRayhorn）的作品。它加载成功，但当我在控制行键入“swap”时，会收到一条“未知命令”错误消息。代码中是否有任何明显的东西可能导致问题，或者我是否需要更深入地查看它是否与我加载的其他Lisp冲突？
 
任何帮助都将不胜感激。
 
;c. 2006 Jeff Rayhorn & LukewarmCoffee.co_
(defun swap ()
(setvar "cmdecho" 0)
(command "undo" "be")
(prompt "\nSelect first group of objects, when done...")
(setq frstset(ssget))
(setq frstpnt(getpoint "\nPick base point for the first group of objects..."))
(prompt "\nSelect second group of objects, when done...")
(setq scndset(ssget))
(setq scndpnt(getpoint "\nPick base point for the second group of objects..."))
(command "move" frstset "" frstpnt scndpnt)
(command "move" scndset "" scndpnt frstpnt)
(command "undo" "e")
(princ)
)

lpseifert 发表于 2022-7-6 11:24:23

在命令行尝试（交换）。。。未经测试
或者编辑代码，使第一行读取（defun c:swap（）

Lee Mac 发表于 2022-7-6 11:33:18

另一种可能的书写方式：
 

(defun c:swap (/ *error* Move s1 s2 p1 p2 )
;; Lee Mac~12.05.10
(vl-load-com)

(defun *error* ( msg )
   (and flag (vla-EndUndoMark doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))

(defun Move ( ss p1 p2 / v1 v2 )
   (mapcar (function set) '(v1 v2)
   (mapcar (function vlax-3D-point) (list p1 p2)))
   
   (
   (lambda ( n / e obj )
       (while (setq e (ssname ss (setq n (1+ n))))
         (if (vlax-method-applicable-p
               (setq obj (vlax-ename->vla-object e)) 'Move)
         (vla-move obj v1 v2)
         )
       )
   )
   -1
   )
)

(if
   (and
   (princ "\nSelect First Group of Objects...")
   (setq s1 (ssget "_:L"))
   (setq p1 (getpoint "\nPick First Base Point: "))
   (princ "\nSelect Second Group of Objects...")
   (setq s2 (ssget "_:L"))
   (setq p2 (getpoint "\nPick Second Base Point: "))
   (setq flag
       (not
         (vla-StartUndoMark
         (setq doc
             (vla-get-ActiveDocument
               (vlax-get-acad-object)
             )
         )
         )
       )
   )
   )
   (progn
   (mapcar (function Move)
       (list s1 s2) (list p1 p2) (list p2 p1)
   )
   (setq flag (vla-EndUndomark doc))
   )
)

(princ)
)
   

Diedesigner 发表于 2022-7-6 11:49:56

用（defun c:swap（）编辑它有效。谢谢
 
李，视觉lisp版本看起来也不错。我是lisp的相对noob；多年来，我更像是一名黑客，让现有的Lisp按我想要的方式工作。我会研究你的，并将其与原件进行比较，以供我自己“学习”。
 
再次感谢！
-克里斯

Lee Mac 发表于 2022-7-6 11:52:46

 
不用担心，它只是得到了更多的错误捕捉，也许会运行得更快一点。
 
李
 
忘了提一下-旧的LISP会弄乱CMDECHO系统变量，并且不会将其设置回原位。

alanjt 发表于 2022-7-6 12:09:39

哈哈，李，真不错。
实际上，我更新了前几天写的一篇旧文章。它只会将一个对象与另一个对象交换（我使用它交换两个块或一个文本对象）。
 
(defun c:EW (/ *error* lst f)
;; Entity Swap
;; Alan J. Thompson, 06.05.08 / 07.10.08 / 05.01.10

(defun *error* (msg)
   (and f *AcadDoc* (vla-EndUndoMark *AcadDoc*))
   (and msg
      (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*"))
      (princ (strcat "\nError: " msg))
   )
)

(if (and (car (setq lst (cons (car (entsel "\nSelect first object: ")) lst)))
          (cadr (vl-remove nil (setq lst (cons (car (entsel "\nSelect second object: ")) lst))))
   )
   ((lambda (pts)
      (setq f (not (vla-StartUndoMark
                     (cond (*AcadDoc*)
                           ((setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
                     )
                   )
            )
      )
      (mapcar (function (lambda (o a b) (vl-catch-all-apply (function vla-move) (list o a b))))
            (mapcar (function vlax-ename->vla-object) lst)
            pts
            (reverse pts)
      )
    )
   (mapcar (function (lambda (x) (vlax-3d-point (cdr (assoc 10 (entget x))))))
             lst
   )
   )
)
(*error* nil)
(princ)
)

alanjt 发表于 2022-7-6 12:20:23

实际上，我在启动时将我的设置为零。

查看完整版本: “交换”lisp不'；t工作