快速建块的问题 知道的进

xman00

本版关于快速建块的贴已有一些，其插入点多为原点或手动指定点。
现求一LSP，达到快速建块的功能，插入点自动获取为选择集中心点，块名为时间点。

因本人道行太浅，不懂啊。仅提供一点思路供大神思考：

此处最难应为获取选择集中心点，赋值为插入点坐标。本人思路为先根据选择集确定其最小包围盒，再根据包围盒计算其中心坐标(块插入点坐标）。

附上本版找到的最小包围盒的LSP，本人机器上测试有缺陷，不能运行，需先行修正或检查（未知是否CAD版本影响，本人08）。

PS：为减小运行错误，及考虑实用价格，先择集对象可考虑过滤放射线及构造线（错误处理）。

大神们努力啊，此LSP应为广大实际应用。本人静待佳音。

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

namezg

按你的要求写了一个。
;快速创建块
;块名为当前时间(如"2012101620161699"),块基点为选择集中心点
;命令：ZG_MakeBlock

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))
;;;________________________________________________________________

namezg

;功能：返回选择集包围盒
;参数: ss--选择集
;返回值：选择集所有实体做为整体的包围盒
;(setq ssbox (GetSSBoundingbox (setq ss (ssget))))
(defun GetSSBoundingbox (ss / i ssn ll rr box ptlist ssbox)
        (if ss
                (progn
                        (setq i -1)
                        (repeat (sslength ss)
                                (setq ssn (ssname ss (setq i (1+ i))))
                                (vla-GetBoundingBox (vlax-ename->vla-object ssn) 'll 'rr)  ;得到对象的包围盒
                                (setq box (list (vlax-safearray->list ll) (vlax-safearray->list rr)))
                                (setq ptlist (append box ptlist))
                        )
                        (setq ssbox (mapcar '(lambda (x) (apply 'mapcar (cons x ptlist))) (list 'min 'max)))
                )
        )
)
中心点
(setq midpt (mapcar '(lambda (a b) (/ (+ a b) 2)) (car ssbox) (cadr ssbox)))
或
(setq midpt (apply 'mapcar (cons (function (lambda (a b) (/ (+ a b) 2))) ssbox)))

liu_kunlun

在0，0，0处建块及insert实体，取得其大小尺寸，再修改其定义点或重新建块

xman00

请楼上写出代码，本人对此不通啊。求助

清风明月名字

这个代码是很有价值，可惜我也不懂

myjping

我的快速建块，空击即是

xman00

myjping 发表于 2012-10-15 08:59
我的快速建块，空击即是

老兄，这个重点是块差入点的位置哈

xman00

xman00 发表于 2012-10-15 12:23
老兄，这个重点是块差入点的位置哈

老兄，整个源码上来啊，版内给你发信息没反应的哇

xman00

namezg 发表于 2012-10-15 20:39
;功能：返回选择集包围盒
;参数: ss--选择集
;返回值：选择集所有实体做为整体的包围盒

老兄，我是不懂LSP的，拜托就写出来嘛，要求更改了一点点，就是块插入选择集下沿中心点，这里好像算法要稍变动一下。

USER2128

;;;________________________________________________________________
;;; 将所选实体转为块（指定插入点），并自动赋名（可改名）。
(defun c:bb (/ osmode cmdecho pt ss ent name txt)
  (setq osmode  (getvar "osmode")
        cmdecho (getvar "cmdecho")
        )
  (if (and (setq pt (getpoint "\n请指定将要制成的块的插入点："))
           (princ "\n请选取要制成块的那些实体：")
           (setq ss (ssget))
           )
    (progn
      (setvar "osmode" 0)
      (setvar "cmdecho" 0)
      (command "._copybase"  pt ss "")
      (command "._PASTEBLOCK" pt)
      (command "._erase" ss "")
      (setq ent (entget (entlast))
            name (cdr (assoc 2 ent))
            )
      (setq txt "请输入块名或接受原块名:")
      (while txt
        (setq txt (dos_getstring "输入块名" txt name))
        (if (and txt (/= (strcase name) (strcase txt)))
          (if (not (tblsearch "BLOCK" txt))
            (progn
              (command "._rename" "_block" name txt)
              (setq name txt
                    txt  nil)
              )
            (setq txt "与图中的已有的块名重名，请重输块名：")
            )
          (setq txt nil)
          ))
      (setvar "cmdecho" cmdecho)
      (setvar "osmode"  osmode)
      (princ "\n制块成功！块名＝") (princ name)
      )
    (princ "\n未指定插入点或未选取实体!")
    )
  (princ))
;;;________________________________________________________________