CafeJr 发表于 2022-7-6 03:05:11

移动多个块或obje

伙计们,
 
有人知道如何使用线条作为参考移动多个块或对象,如下图所示(使用镜子在端点之间的中点或端点):
 

 
谢谢
https://www.cadtutor.net/forum/images/misc_cadtutor/pencil.png

pBe 发表于 2022-7-6 03:09:20

使用块和命令“\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)
)

jdiala 发表于 2022-7-6 03:13:50

这将镜像块,即使它不位于直线的端点。
 
(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)
)

pBe 发表于 2022-7-6 03:16:43

我想过“不在一条线的端点”之类的东西,但在这种情况下。。
 

 
所以我保留了我正在编写的代码,它与您的代码惊人地相似。我想在选择中包括的不仅仅是块
 
随便。让我们等待OP澄清它是否包含除单个块之外的对象

Lee Mac 发表于 2022-7-6 03:21:06

这里有一种替代方法:

(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)
)
               

jdiala 发表于 2022-7-6 03:25:33

 
我只是假设。根据图片,这些线与其他圆不在同一点上。见圆圈4和5。
 
44488
 
我想一个接一个地做。。。我也有和李一样的想法。将端点与起点切换,反之亦然,但OP希望使用镜像。

jdiala 发表于 2022-7-6 03:31:09

嘿,伙计们,不使用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
         )
       )

Lee Mac 发表于 2022-7-6 03:32:58

 
对于这种方法,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)

 
仍然没有修改为包含无镜像块。

pBe 发表于 2022-7-6 03:37:40

哇。。。伙计们,我在读这些帖子,对此非常满意。。。问题是只在参考线上移动数量不确定的物体,该线从块或物体的中点开始(触摸它),然后使用端点或中点上的镜像移动它。。。但提出的替代方案比我预期的要好。明天我会试试。。。
 
谢谢

CafeJr 发表于 2022-7-6 03:39:29

不客气CafeJr,让我们知道你进展如何
页: [1] 2
查看完整版本: 移动多个块或obje