平移LISP例程
我只是想分享一下我昨天创造的一个惯例——我希望其他人觉得它有用。有时，我会遇到需要将模型的一部分移动很远的情况，每次更新视口时，我都需要花费几分钟的时间，以便我在图纸空间中的引线和标记与移动的模型对齐。我发现的唯一技术就是这个，当我把东西移到一千多英尺远的地方时，这个技术并不实用。
以下是LISP的工作原理。进入模型空间，在旧位置和新位置之间画一条线。然后进入paperspace，进入需要更新的视口。只需用“PANLINE”启动命令，然后单击该行。我还提供了一个选项，可以根据绘制线的方式反转平移方向，如果视口被锁定，还提供了一个警告。
代码如下：
(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 <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 干得好
如果你不介意的话，请说几句：
-有一个讨论始终必须允许用户在不强制按ESC键的情况下退出（并错误退出），因此您可以使用此选项更改行提示循环（因此按enter键可以退出例程）：
(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)
(initget 6 "Yes No")
(if (= (setq option (getkword "\nReverse pan direction? <No>: ")) "Yes")
(command "_.-pan" p1 p2)
)
(princ "\nPan complete.")
); progn
); if
-------------------
(setq flag f)
也许你会：
(setq flag nil)
但无论如何，这一行是多余的，因为这个标志符号是局部的，并且没有设置为任何值。
-------
(setq option (getkword "\nReverse pan direction? (Yes/No) <No>: "))
请注意，使用了括号的类型，因此这将改变提示行为（无论您在哪里按“N”或“Y”键）。
(setq option (getkword "\nReverse pan direction? <No>: "))
希望这有帮助。 感谢您的宝贵意见！我执行了以下所有更改：
(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? <No>: "))
(if (= option "Yes")
(progn
(command ".-pan" p1 p2)
(command ".-pan" p1 p2)
)
)
(princ "\nPan complete.")
)
)
));end progn/if
(princ)
);end defun
页:
[1]