使用存储特定点
大家好，我正在编写一个例程，将图纸空间中所有绘制的对象从drawingframe右下方移动到点0,0。我必须存储这一点，以便接下来可以使用move命令使用它。
感谢您的输入，以获得一些像样的编码。。
检查
http://www.lee-mac.com/ssboundingbox.html
;; Selection Set Bounding Box-Lee Mac
;; Returns a list of the lower-left and upper-right WCS coordinates of a
;; rectangular frame bounding all objects in a supplied selection set.
;; s - Selection set for which to return bounding box
(defun LM:ssboundingbox ( s / a b i m n o )
(repeat (setq i (sslength s))
(if
(and
(setq o (vlax-ename->vla-object (ssname s (setq i (1- i)))))
(vlax-method-applicable-p o 'getboundingbox)
(not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list o 'a 'b))))
)
(setq m (cons (vlax-safearray->list a) m)
n (cons (vlax-safearray->list b) n)
)
)
)
(if (and m n)
(mapcar '(lambda ( a b ) (apply 'mapcar (cons a b))) '(min max) (list m n))
)
)
(defun c:test ( / b s )
(if
(and
(setq s (ssget))
(setq b (LM:ssboundingbox s))
)
(entmake
(append
'(
(000 . "LWPOLYLINE")
(100 . "AcDbEntity")
(100 . "AcDbPolyline")
; MAKE THE POLYLINE ON DEFPOINTS
(090 . 4)
(070 . 1)
)
(mapcar '(lambda ( x ) (cons 10 (mapcar '(lambda ( y ) ((eval y) b)) x)))
'(
(caar cadar)
(caadrcadar) ; THIS IS UNDER RIGHT, HOW TO STORE THIS POINT AS PAPER_ORIGIN?
(caadr cadadr)
(caarcadadr)
)
)
)
)
)
(COMMAND "MOVE" "ALL" ""
(caadrcadar) ; THIS IS UNDER RIGHT, STORED POINT FOR PAPER_ORIGIN
"0,0" "")
(princ)
)
(vl-load-com)
你好，哈勒姆，
首先，感谢您保留了我的代码头并提供了原始代码的链接，我非常感谢您的小小礼遇。
对于您的任务，请尝试以下代码：
;; Selection Set Bounding Box-Lee Mac
;; Returns a list of the lower-left and upper-right WCS coordinates of a
;; rectangular frame bounding all objects in a supplied selection set.
;; s - Selection set for which to return bounding box
(defun LM:ssboundingbox ( s / a b i m n o )
(repeat (setq i (sslength s))
(if
(and
(setq o (vlax-ename->vla-object (ssname s (setq i (1- i)))))
(vlax-method-applicable-p o 'getboundingbox)
(not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list o 'a 'b))))
)
(setq m (cons (vlax-safearray->list a) m)
n (cons (vlax-safearray->list b) n)
)
)
)
(if (and m n)
(mapcar '(lambda ( a b ) (apply 'mapcar (cons a b))) '(min max) (list m n))
)
)
(defun c:test ( / b s )
(if
(and
(setq s (ssget))
(setq b (LM:ssboundingbox s))
)
(command "_.move" s "" "_non" (list (caadr b) (cadar b)) "_non" '(0.0 0.0))
)
(princ)
)
(vl-load-com) 很棒的代码！谢谢你的时间和努力。
以下挑战。。。
我想将代码与脚本结合使用，一次性组织一组dwg（使用其他工具；-）
因此，我想去掉select提示符，但如果您使用类似
(ssget "X" )(67 . 1) ; only the paperspace stuff..
但奇怪的事情发生在运动中。它不再是0,0了
也许模型空间中绘制的内容仍然会混淆。(?)那么，我们真的希望有办法做到这一点吗？ 尝试以下操作：
(defun c:test ( / box ctb sel )
(setq ctb (getvar 'ctab))
(foreach tab (layoutlist)
(setvar 'ctab tab)
(if (and (setq sel (ssget "_X" (list '(-4 . "<NOT") '(-4 . "<AND") '(0 . "VIEWPORT") '(69 . 1) '(-4 . "AND>") '(-4 . "NOT>") (cons 410 tab))))
(setq box (LM:ssboundingbox sel))
)
(command "_.move" sel "" "_non" (list (caadr box) (cadar box)) "_non" '(0.0 0.0))
)
)
(setvar 'ctab ctb)
(princ)
)
对不起，李，我只是好像没法用。
命令：测试
; 错误：错误的参数类型：lselsetp nil
错误的参数类型：consp“AND>”
也许我没有输入正确的文字，我也想移动视口。纸面上的一切。。
试图使用此代码。。
(ssget "_X" (list '(69 . 1) (cons 410 tab)))
似乎被移动命令卡住了，不知道为什么。
“非”真正迫使它做什么？
没有结果，事情不会改变。。。
6 李，我在第二篇文章中用模式尝试了你的代码。我喜欢那个。。。
然而结合Wscript（v1.2）让我想到了如何用于paperspace的问题。。。
如何在paperspace中仅选择和所有对象？。。这很难。。至少对我来说。。
下图：将m2or_sel读作“移动到原点_u选择项目”。。
你好，汉斯
很抱歉，汉斯，我在上面的代码中漏掉了几个撇号（这将教会我直接在论坛邮箱中键入代码！）我现在已经更新了上述代码。
请注意，我的代码并没有排除所有视口，只是排除了不应移动的图纸空间视口本身（显示图纸空间布局的视口）。
当通过AutoLISP向命令提供点输入时，要求“非”忽略任何活动的对象捕捉模式。 .. 竖起大拇指。。！！
我把这个小视频放在一起演示。
与编剧相结合的例程将使我更容易找到和替换标题栏。
很好的演示，汉斯-我很高兴看到它运行良好
页:
[1]