实体随图块拷贝

Lispboy

[sell]

(defun c:XDTB_CopyWithBlk ( / blk e ents mat mat1 mat2 ss ss1 x)
  (if (and
        (setq e (car (xdrx_entsel "\n选取图块<退出>:" '((0 . "INSERT")))))
        (setq blk (xdrx_getpropertyvalue e "blocktablerecord"))
        (xdrx_initssget "\n选取要拷贝的实体<退出>:")
        (setq ss (xdrx_ssget))
        (setq ss1 (ssget "x" (list '(0 . "INSERT") (cons 2 (car blk)))))
        (> (sslength ss1) 1)
      )
    (progn
      (xdrx_begin)
      (setq ss1 (ssdel e ss1)
            mat1 (xdrx_matrix_block2wcs e)
            mat1 (xdrx_matrix_inverse mat1)
            ents (xdrx_pickset->ents ss)
      )
      (mapcar
        '(lambda (x)
           (setq mat2 (xdrx_matrix_block2wcs x)
                 mat (xdrx_matrix_product mat2 mat1)
           )
           (xdrx_entity_transformedcopy ents mat)
         )
        (xdrx_pickset->ents ss1)
      )
      (xdrx_prompt "\n成功随块" (car blk) "拷贝了 " (* (sslength ss1)
                                                       (length ents)
                                                    ) " 个实体."
      )
      (xdrx_end)
    )
  )
  (princ)
)

[/sell]

yoyoho

正需要的功能，感謝 Lispboy 楼主大人了！

c212007

正需要，支持楼主大人了！