修复Lee Mac的CopyRel Lisp

lutzow10 · 发表于 2022-7-5 15:51:49

大家好，

CAD导师新手。我来这里是想找一个lisp例程，从一个点到最后一个复制点的不同距离进行多个复制。

我在一个旧帖子上找到了李的Lisp程序程序，但我遇到了麻烦。我正在使用AutoCAD 2018。

(defun c:copyrel ( / b i l o p q s )
   (if
       (and
           (setq s (ssget "_:L"))
           (setq p (getpoint "\nSpecify Base Point: "))
           (setq b (vlax-3D-point (trans p 1 0)))
       )
       (progn
           (repeat (setq i (sslength s))
               (setq l (cons (vlax-ename->vla-object (ssname s (setq i (1- i)))) l))
           )
           (while (setq q (acet-ss-drag-move s p "\nSpecify Second Point: " 0 0))
               (setq s (ssadd))
               (foreach x l
                   (vla-move (setq o (vla-copy x)) b (vlax-3D-point (trans q 1 0)))
                   (ssadd (vlax-vla-object->ename o) s)
               )
               (setq p q)
           )
       )
   )
   (princ)
)
(vl-load-com)
(princ)

所以它似乎一直持续到第二份。我的问题是我无法控制第二份的方向。此外，距离对于其复制到的方向也不正确。

我试图用它来快速绘制柱网。我打开了正交模式。我的第一个副本是水平的，第二个也是水平的，所有的视觉提示都显示为它将被水平复制，就像另一个副本一样。但是，其结果是向下复制对象。甚至没有达到正确的距离。例如，我输入了20'-8“，它在Y轴上复制了7''。

这正是我想要的，所以如果有人能帮我解决这个问题，那就太棒了！！

lutzow10 · 发表于 2022-7-5 16:03:02

链接到OP：http://www.cadtutor.net/forum/showthread.php?71563-相对于上次复制位置的复制功能

ReMark · 发表于 2022-7-5 16:09:00

看看这个是否有效。命令名为copyrel，而不是copyrel。

测试。lsp

顺便提一下不是我写的。。。李·麦克做到了。这是他在2012年8月6日发布到帖子上的两个非常相似的例程中的第一个。

我想你用了第二套。

在我的测试中，lisp例程起了作用。我正在运行AutoCAD 2018。

lutzow10 · 发表于 2022-7-5 16:21:42

成功了！谢谢。

ReMark · 发表于 2022-7-5 16:29:19

我很高兴听到你也这么做了。谢谢你更新我们。

对于其他感兴趣的人，可以在本线程的第8篇文章中找到例程的两个版本。我不知道为什么第二个在AutoCAD 2018中没有按预期工作。我也有问题，这就是为什么我在回答上述问题之前尝试了第一个版本。

http://www.cadtutor.net/forum/showthread.php?71563-相对于上次复制位置的复制功能

lutzow10 · 发表于 2022-7-5 16:29:29

这是一个延伸，但我想我会问，是否有任何方式可以像默认的复制或移动命令一样打开被复制对象的预览？

我可能只是用这个命令替换copy命令，但有时对于不精确的复制，我只是直观地使用它，这是lisp目前不允许的，因为没有预览。

就像我说的，这完全是在黑暗中拍摄的，所以如果做不到，不用担心

再次感谢您的帮助！使布置柱网成为小菜一碟

ReMark · 发表于 2022-7-5 16:39:17

你的要求超出了我的专业水平。不过，这里的一位Lisp程序大师应该能够回答你的问题。耐心

Grrr · 发表于 2022-7-5 16:50:30

我能用grread做的最接近的事情是：

copy

(defun C:copyrel ( / SS b r )
 (and (setq SS (ssget "_:L")) (setq b (getpoint "\nSpecify Base Point: ")) (setq r (my-ss-drag-move b SS))
   (while r (princ "\nSpecify next point <exit>: ") 
     (setq r (apply 'my-ss-drag-move r))
   )
 )
 (princ)
)
(vl-load-com) (princ)
(defun my-ss-drag-move ( b SS / _MoveSS _CopySS _MoveCopySS SS b i L nL g s p prev nSS tmp )
 '(87 114 105 116 116 101 110 32 98 121 32 71 114 114 114)
 (setq _MoveSS (lambda ( L p1 p2 ) (foreach x L (vla-Move x p1 p2))))
 (setq _CopySS (lambda ( L ) (foreach x L (setq nL (cons (vla-Copy x) nL))) nL))
 (and (or SS (setq SS (ssget "_:L"))) (or b (setq b (getpoint "\nSpecify Base Point: ")))
   (setq b (trans b 1 0))
   (repeat (setq i (sslength SS)) (setq L (cons (vlax-ename->vla-object (ssname SS (setq i (1- i)))) L)))
   (setq nL (_CopySS L))
   (while (not s) (setq g (grread T)) (redraw)
     (cond
       ( (equal g '(2 13)) (setq s T) )
       ( (= (car g) 5) (if p (grdraw b p 1 3)) (setq p (trans (cadr g) 1 0)) (_MoveSS nL (cond (prev (vlax-3D-point prev))((vlax-3D-point b))) (vlax-3D-point p)) (setq prev p) )
       ( (= (car g) 3) (if (setq tmp (getpoint "\nTo snap specify again <back>: ")) (progn (_MoveSS nL (vlax-3D-point prev) (vlax-3D-point tmp)) (setq s T)))  )
       ( (= (car g) 25) (setq prev nil) (mapcar 'vla-Delete nL) (setq s T) )
     ); cond                
   ); while
 ); and
 (redraw)
 (if tmp (list tmp (progn (setq nSS (ssadd)) (mapcar (function (lambda (x) (ssadd (vlax-vla-object->ename x) nSS))) nL) nSS)))
); defun my-ss-drag-move

但正如您所见，由于捕捉问题，它需要额外的点输入（否则，没有该输入，您将无法在任何地方捕捉[预览捕捉]）。
虽然我认为仍然可以通过使用这样的东西来复制acet ss拖动动作。

Roy_043 · 发表于 2022-7-5 16:54:15

如果您不关心acet-ss-drag-move及其效果，那么下面的代码将起作用。与本文讨论的Lee代码相比，它还具有复制关联关系（例如尺寸和填充图案）的优势。

copy

(vl-load-com)
(defun c:CopyRelAlt ( / *error* doc end org ss sta)
 (defun *error* (msg)
   (setvar 'cmdecho 1)
   (vla-endundomark doc)
 )
 (setq doc (vla-get-activedocument (vlax-get-acad-object)))
 (vla-endundomark doc)
 (vla-startundomark doc)
 (if
   (and
     (setq ss (ssget))
     (setq org (getpoint "\nBase point: "))
   )
   (progn
     (setq sta org)
     (setvar 'cmdecho 0)
     (while (setq end (getpoint sta "\nSecond point or Enter: "))
       (command "_.copy" ss "" "_non" org "_non" end)
       (setq sta end)
     )
     (setvar 'cmdecho 1)
   )
 )
 (vla-endundomark doc)
 (princ)
)

[编程交流] 修复Lee Mac的CopyRel Lisp

发表回复

精选推荐