平移LISP例程

plackowski · 发表于 2022-7-5 16:50:11

我只是想分享一下我昨天创造的一个惯例——我希望其他人觉得它有用。

有时，我会遇到需要将模型的一部分移动很远的情况，每次更新视口时，我都需要花费几分钟的时间，以便我在图纸空间中的引线和标记与移动的模型对齐。我发现的唯一技术就是这个，当我把东西移到一千多英尺远的地方时，这个技术并不实用。

以下是LISP的工作原理。进入模型空间，在旧位置和新位置之间画一条线。然后进入paperspace，进入需要更新的视口。只需用“PANLINE”启动命令，然后单击该行。我还提供了一个选项，可以根据绘制线的方式反转平移方向，如果视口被锁定，还提供了一个警告。

代码如下：

copy

(defun c:PANLINE ( / lock flag alrt line p1 p2 option)
;Pans from one end of a line to another.
;Useful for updating a viewport when objects in modelspace have been moved.
;Created by Perry Lackowski on 12/22/2016
(VL-LOAD-COM)
(setq lock (VLA-GET-DISPLAYLOCKED (VLA-GET-ACTIVEPVIEWPORT (VLA-GET-ACTIVEDOCUMENT (VLAX-GET-ACAD-OBJECT)))));
(setq alrt (VL-SYMBOL-NAME lock))
(IF (= alrt ":vlax-true")
        (princ "\nCannot pan inside a locked viewport")
        (progn
        ;Prevents the rest of the code from running if an active viewport is locked.
        
                (setq flag f)
                (while (not flag)
                         (setq line (car (entsel "\nSelect Line : ")))
                        (cond   (  (null line)                                        (princ "\nNothing selected, Please try again.")                  )
                                (  (= (cdr (assoc 0 (entget line))) "LINE")        (setq flag t)                                                  )
                                (  t                                                (princ "\nSelected object is not line, Please try again."))
                        )
                )
                (setq p1 (cdr (assoc 10 (entget line))))
                   (setq p2 (cdr (assoc 11 (entget line))))
                ;retrieves the contents of group codes 10 and 11 which contain the first and second point of the line.
        
                (command ".-pan" p2 p1)
                (princ "Reverse direction [Yes/No] <No>:")
                (initget 6 "Yes or No")
                (setq option (getkword "\nReverse pan direction? (Yes/No) <No>: "))
                (if (= option "Yes")
                        (progn
                                (command ".-pan" p1 p2)
                                (command ".-pan" p1 p2)
                        )
                )
        (princ "\nPan complete.")
));end progn/if
(princ)
);end defun

Grrr · 发表于 2022-7-5 17:32:23

干得好
如果你不介意的话，请说几句：
-有一个讨论始终必须允许用户在不强制按ESC键的情况下退出（并错误退出），因此您可以使用此选项更改行提示循环（因此按enter键可以退出例程）：

copy


(while (not flag)
 (setq line (car (entsel "\nSelect Line <exit> : ")))
 (cond   
   ( (= 7 (getvar 'errno)) (princ "\nNothing selected, Please try again.") (setvar 'errno 0) )
   ( (and line (/= (cdr (assoc 0 (entget line))) "LINE"))        (princ "\nSelected object is not line, Please try again.") )
   (t (setq flag t) )
 )
)

以下内容可能是：

copy


(if line
 (progn
   (setq p1 (cdr (assoc 10 (entget line))))
   (setq p2 (cdr (assoc 11 (entget line))))
   ;retrieves the contents of group codes 10 and 11 which contain the first and second point of the line.
   
   (command "_.-pan" p2 p1)
   
   (initget 6 "Yes No")
   (if (= (setq option (getkword "\nReverse pan direction? [Yes/No] <No>: ")) "Yes")
     (command "_.-pan" p1 p2)
   )
   (princ "\nPan complete.")
 ); progn
); if

-------------------

copy

(setq flag f)

也许你会：

copy

(setq flag nil)

但无论如何，这一行是多余的，因为这个标志符号是局部的，并且没有设置为任何值。
-------

copy

(setq option (getkword "\nReverse pan direction? (Yes/No) <No>: "))

请注意，使用了括号的类型，因此这将改变提示行为（无论您在哪里按“N”或“Y”键）。

copy

(setq option (getkword "\nReverse pan direction? [Yes/No] <No>: "))

希望这有帮助。

plackowski · 发表于 2022-7-5 18:08:30

感谢您的宝贵意见！我执行了以下所有更改：

copy

(defun c:PANLINE ( / lock flag alrt line p1 p2 option)
;Pans from one end of a line to another.
;Useful for updating a viewport when objects in modelspace have been moved.
;Created by Perry Lackowski on 12/22/2016
(VL-LOAD-COM)
(setq lock (VLA-GET-DISPLAYLOCKED (VLA-GET-ACTIVEPVIEWPORT (VLA-GET-ACTIVEDOCUMENT (VLAX-GET-ACAD-OBJECT)))));
(setq alrt (VL-SYMBOL-NAME lock))
(IF (= alrt ":vlax-true")
        (princ "\nCannot pan inside a locked viewport")
        (progn
        ;Prevents the rest of the code from running if an active viewport is locked.
                (while (not flag)
                        (setq line (car (entsel "\nSelect Line <exit> : ")))
                        (cond   
                                ( (= 7 (getvar 'errno)) (princ "\nNothing selected, Please try again.") (setvar 'errno 0) )
                                ( (and line (/= (cdr (assoc 0 (entget line))) "LINE"))        (princ "\nSelected object is not line, Please try again.") )
                                (t (setq flag t) )
                        )
                )
                (if line
                        (progn
                                (setq p1 (cdr (assoc 10 (entget line))))
                                (setq p2 (cdr (assoc 11 (entget line))))
                                ;retrieves the contents of group codes 10 and 11 which contain the first and second point of the line.
                                (command ".-pan" p2 p1)
                                (princ "Reverse direction (Yes/No) <No>:")
                                (initget 6 "Yes or No");initializes the next get function to only accept yes and no
                                (setq option (getkword "\nReverse pan direction? [Yes/No] <No>: "))
                                (if (= option "Yes")
                                        (progn
                                                (command ".-pan" p1 p2)
                                                (command ".-pan" p1 p2)
                                        )
                                )
                                (princ "\nPan complete.")
                        )
                )
));end progn/if
(princ)
);end defun

[编程交流] 平移LISP例程

发表回复

精选推荐

浏览过的版块