快速建块的问题 知道的进

阿霸jun

获取每一个图元的包围盒然后取最小和最大值以获取对象中点这样遍历是不是很浪费呀？
如果先设定一个点比如说原点，再获取包围盒，然后修改插入点是不是要快一点啊？

zhengxq7

楼上的程序很好，我很需要，但是程序在输入快名的时候出错。能不能整理一下，干脆取消输入快名行了，只要自动赋名就可以。

USER2128

zhengxq7 发表于 2013-9-29 17:35
楼上的程序很好，我很需要，但是程序在输入快名的时候出错。能不能整理一下，干脆取消输入快名行了，只要自 ...

;;;________________________________________________________________
;;; 将所选实体转为块（指定插入点），并自动赋名（优化版）。
;;; 作者: USER2128于bbs.mjtd.com, 20130930
(defun c:BB (/ pt ss ent name)
  (if (and (setq pt (getpoint "\n请指定将要制成的块的插入点："))
           (princ "\n请选取要制成块的那些实体：")
           (setq ss (ssget))
           )
    (progn
      (command "._copybase" "_non" pt ss "")
      (command "._PASTEBLOCK" "_non" pt)
      (command "._erase" ss "")
      (setq ent (entget (entlast))
            name (cdr (assoc 2 ent))
            )
      (princ "\n制块成功！块名＝") (princ name)
      )
      
    (princ "\n未指定插入点或未选取实体!")
    )
  (princ))
;;;________________________________________________________________

zhengxq7

万分感谢楼上的，明经是个好地方，有那么多好心的人。
再次表示感谢

langjs

试试这个，以前编的，觉得还算方便

(defun c:qk (/ i maxpoint maxx maxx0 maxy maxy0 minpoint minx minx0 miny miny0 name pmax pmin pt ss)
  (vl-load-com)
  (setvar "cmdecho" 0)
  (setq ss (ssget))
  (if ss
    (progn
      (command ".undo" "be")
      (setq pt (getpoint "\n指定块插入基点:<中心>"))
      (if (= pt nil)
        (progn
          (setq minx0 1e6  miny0 1e6 maxx0 -1e6  maxy0 -1e6 )
          (repeat (setq i (sslength ss))
            (setq name (ssname ss (setq i (1- i))))
            (vla-getboundingbox (vlax-ename->vla-object name) 'minpoint 'maxpoint)
            (setq pmax (vlax-safearray->list maxpoint)  pmin (vlax-safearray->list minpoint))
            (setq minx (car pmin)  maxx (car pmax)  miny (cadr pmin)  maxy (cadr pmax))
            (if (> minx0 minx) (setq minx0 minx))
            (if (> miny0 miny) (setq miny0 miny))
            (if (< maxx0 maxx) (setq maxx0 maxx))
            (if (< maxy0 maxy) (setq maxy0 maxy) )
          )
          (setq pt (list (/ (+ minx0 maxx0) 2) (/ (+ miny0 maxy0) 2) 0.0))
        )
      )
      (setq snap (getvar "osmode"))
      (setvar "osmode" 0)
      (setq name (substr (rtos (getvar "CDATE") 2 8) 10 17))
      (command "block" name pt ss "")
      (command "INSERT" name pt 1 1 0)
      (princ (strcat "\n已新建块名为 \"" name "\" 的图块"))
      (setvar "osmode" snap)
      (command ".undo" "e")
    )
  )
  (princ)
)

dhtfm

都很好用，都不知道该用哪个了。谢谢。

519995995

langjs 发表于 2013-9-30 11:08
试试这个，以前编的，觉得还算方便

(defun c:qk (/ i maxpoint maxx maxx0 maxy maxy0 minpoint minx mi ...

谢谢，正需要。

fire9527

langjs 发表于 2013-9-30 11:08
试试这个，以前编的，觉得还算方便

(defun c:qk (/ i maxpoint maxx maxx0 maxy maxy0 minpoint minx mi ...

狼大侠，能否改编一个块名为：固定前缀+时间   的版本呢？
其它都不变，比如生成的块都名为：狼20150205233413，其中时间为做块当时的电脑时间，非常需要，期盼啊

大中华

我当宝贝收藏了！！

htlaser

fire9527 发表于 2015-2-5 23:38
狼大侠，能否改编一个块名为：固定前缀+时间   的版本呢？
其它都不变，比如生成的块都名为：狼20150205 ...

• 块名称：固定前缀+时间  (华星切割2018-09-13-16-38-32)