移动多个块或obje
伙计们,有人知道如何使用线条作为参考移动多个块或对象,如下图所示(使用镜子在端点之间的中点或端点):
谢谢
https://www.cadtutor.net/forum/images/misc_cadtutor/pencil.png 使用块和命令“\u mirror”的快速方法
(defun c:mbt (/ ss ln p1 1p 2p)
(vl-load-com)(setvar 'osmode 0)
(if (setq ss (ssget '((0 . "INSERT"))))
(repeat (setq i (sslength ss))
(vla-getboundingbox
(vlax-ename->vla-object
(setq e (ssname ss (setq i (1- i))))
)
'mn
'mx
)
(if (setq ln (ssget "_C"
(vlax-safearray->list mn)
(vlax-safearray->list mx)
'((0 . "LINE"))
)
)
(command "_mirror"
e
""
(setq p1 (mapcar (function (lambda (a b) (/ (+ a b) 2.)))
(setq 1p
(cdr (assoc 10 (setq ent (entget (ssname ln 0)))))
)
(setq 2p (cdr (assoc 11 ent)))
)
)
"_non"
(polar p1 (+ (/ pi 2.0) (angle 1p 2p)) 1.0)
"_Yes"
)
)
)
)
(princ)
) 这将镜像块,即使它不位于直线的端点。
(defun C:test (/ bl l ss i el p p1 p2)
(setq ss (ssget "_:l" '((0 . "INSERT,LINE"))))
(repeat (setq i (sslength ss))
(if (= "INSERT" (cdr (assoc 0 (entget (ssname ss (setq i (1- i)))))))
(setq bl (cons (ssname ss i) bl))
(setq l (cons (ssname ss i) l))
)
)
(if
(= (length bl) (length l))
(foreach x bl
(setq el
(vl-sort
(append
(mapcar
(function
(lambda (a)
(cons a
(distance
(cdr (assoc 10 (entget x)))
(cdr (assoc 10 (entget a)))
)
)
)
) l
)
(mapcar
(function
(lambda (a)
(cons a
(distance
(cdr (assoc 10 (entget x)))
(cdr (assoc 11 (entget a)))
)
)
)
) l
)
)
(function
(lambda (e1 e2)
(<(cdr e1) (cdr e2))
)
)
)
)
(setq p1 (cdr (assoc 10 (entget (caar el))))
p2 (cdr (assoc 11 (entget (caar el))))
p(mapcar (function (lambda (a b) (/ (+ a b) 2.))) p1 p2))
(command "_.mirror" x "" "_non" p "_non" (polar p (+ (angle p1 p2)(/ pi 2.)) 1)"y")
)
(princ "\nSelected entities are not equal. Try again!")
)
(princ)
)
我想过“不在一条线的端点”之类的东西,但在这种情况下。。
所以我保留了我正在编写的代码,它与您的代码惊人地相似。我想在选择中包括的不仅仅是块
随便。让我们等待OP澄清它是否包含除单个块之外的对象 这里有一种替代方法:
(defun c:mblk ( / blk enx idx itm ls1 ls2 sel )
(if (setq sel (ssget "_:L" '((0 . "INSERT,LINE"))))
(progn
(repeat (setq idx (sslength sel))
(setq enx (entget (ssname sel (setq idx (1- idx)))))
(if (= "INSERT" (cdr (assoc 0 enx)))
(setq ls1 (cons (cons (cdr (assoc 10 enx)) (assoc -1 enx))ls1))
(setq ls2 (cons (cons (cdr (assoc 10 enx)) (cdr (assoc 11 enx))) ls2))
)
)
(foreach blk ls1
(vl-some
(function
(lambda ( x / y )
(if
(cond
( (equal (car blk) (car x) 1e-
(setq y (cdr x))
)
( (equal (car blk) (cdr x) 1e-
(setq y (car x))
)
)
(progn
(setq ls2 (vl-remove x ls2))
(entmod (list (cdr blk) (cons 10 y)))
)
)
)
)
ls2
)
)
)
)
(princ)
)
我只是假设。根据图片,这些线与其他圆不在同一点上。见圆圈4和5。
44488
我想一个接一个地做。。。我也有和李一样的想法。将端点与起点切换,反之亦然,但OP希望使用镜像。 嘿,伙计们,不使用append我怎么能做到这一点呢。谢谢
(append
(mapcar
(function
(lambda (a)
(cons a
(distance
(cdr (assoc 10 (entget x)))
(cdr (assoc 10 (entget a)))
)
)
)
) l
)
(mapcar
(function
(lambda (a)
(cons a
(distance
(cdr (assoc 10 (entget x)))
(cdr (assoc 11 (entget a)))
)
)
)
) l
)
)
对于这种方法,vl排序的使用效率很低:当程序只需要最接近块插入点的项时,无需为foreach循环的每次迭代对列表中的每个项重新排序。
对于你的方法,我建议如下:
(defun c:test ( / d1 d2 en id l1 l2 p1 ss )
(if (setq ss (ssget "_:L" '((0 . "INSERT,LINE"))))
(progn
(repeat (setq id (sslength ss))
(setq en (entget (ssname ss (setq id (1- id)))))
(if (= "INSERT" (cdr (assoc 0 en)))
(setq l1 (cons (list (cdr (assoc 10 en)) (cdr (assoc -1 en))) l1))
(setq l2 (cons (list (cdr (assoc 10 en)) (cdr (assoc 11 en))) l2))
)
)
(foreach br l1
(setq d1 (dis (car br) (car l2))
en (car l2)
)
(foreach ln (cdr l2)
(if (< (setq d2 (dis (car br) ln)) d1)
(setq d1 d2
en ln
)
)
)
(command "_.mirror" (cadr br) ""
"_non" (setq p1 (apply 'mapcar (cons '(lambda ( a b ) (/ (+ a b) 2.0)) en)))
"_non" (polar p1 (+ (apply 'angle en) (/ pi 2.0)) 1.0)
"_Y"
)
)
)
)
(princ)
)
(defun dis ( a b )
(min (distance a (car b)) (distance a (cadr b)))
)
(princ)
仍然没有修改为包含无镜像块。 哇。。。伙计们,我在读这些帖子,对此非常满意。。。问题是只在参考线上移动数量不确定的物体,该线从块或物体的中点开始(触摸它),然后使用端点或中点上的镜像移动它。。。但提出的替代方案比我预期的要好。明天我会试试。。。
谢谢 不客气CafeJr,让我们知道你进展如何
页:
[1]
2