9609759 发表于 2022-9-12 16:47:48

Vlisp的方法创建一个块，返回OBJ对象

本帖最后由 9609759 于 2022-9-13 08:52 编辑

分享一个自己写的一个用vlisp的方法，创建块的程序。
最稳定的创建块的方法，速度比command快很多！

;测试代码
;将对象转换成块
(defun c:tt ( / )
(defun ss->ename (ss / x);选择集转图元名的表
    (if ss
      (vl-remove-if-not;移除空的
      '(lambda (x)
          (= (type x) 'ename);判断类型是否是图元名
      )
      (mapcar
          'cadr
          (ssnamex ss)    ;选择集改图元名
      )
      )
    )
)
(setq ss (ssget))
(setq lst_ename (ss->ename ss))
(setq pt (getpoint "请指定基点"))
;命令 创建块 ，并在in_pt处插入块 删除选择集返回插入的块对象
(setq obj (add_blocks lst_ename pt pt "*U" t))
(alert (strcat "成功创建块："(vla-get-Name obj)))
(princ)
)



;----传入参数说明-----
; lst_ename : 图元名的表
; pt ：块的基点
; in_pt : 创建完后，插入的块的坐标 , 设置为nil时，只创建块集合对象，不插入块。返回这个块集合的对象！
; name： 块的名字(名字为 "*U" 时，将创建匿名块)
; dele; 指定是否删除原有的对象 ，T or nil ,

;示例
;创建块 ，并在in_pt处插入块 删除选择集返回插入后的块对象
;(add_blocks lst_ename pt in_pt "*U" t)

;创建块 ，并在in_pt处插入块 不删除选择集返回插入后的块对象
;(add_blocks lst_ename pt in_pt "*U" nil)

;创建块 ，不删除选择集 不插入这个块，返回创建的块集合对象
;(add_blocks lst_ename pt nil "*U" nil)

9609759 发表于 2022-9-27 17:04:33

感谢上面提供明经币的几位大哥，现在将代码直接附上！无需下载了



;----传入参数说明-----
; lst_ename : 图元名的表
; pt ：块的基点
; in_pt : 创建完后，插入的块的坐标 , 设置为nil时，只创建块集合对象，不插入块。返回这个块集合的对象！
; name： 块的名字(名字为 "*U" 时，将创建匿名块)
; dele; 指定是否删除原有的对象 ，T or nil ,



;创建块 ，并在in_pt处插入块 删除选择集返回插入后的块对象
;(add_blocks lst_ename pt in_pt "*U" t)

;创建块 ，并在in_pt处插入块 不删除选择集返回插入后的块对象
;(add_blocks lst_ename pt in_pt "*U" nil)

;创建块 ，不删除选择集 不插入这个块，返回创建的块集合对象
;(add_blocks lst_ename pt nil "*U" nil)

(defun add_blocks (lst_ename pt in_pt name dele / arr lst_var modspe obj obj_block obj_doc pt1 x y)
        (if (and lst_ename pt name)
                (progn
                        ;坐标转变体
                        (setq pt1 (vlax-3D-point pt))
                        ;图纸对象
                        (setq obj_doc (vla-get-ActiveDocument (vlax-get-acad-object)))
                        ;模型空间对象
                        (setq modspe (vla-get-modelspace obj_doc))
                        ;创建一个空的块
                        (setq obj_block (vla-Add (vla-get-Blocks obj_doc) pt1 name))
                        ;获取块名
                        (setq name (vla-get-Name obj_block))
                        ;图元名表转变体表
                        (setq lst_var (mapcar '(lambda(x)
                                                                                (setq obj (vlax-ename->vla-object x))
                                                                                (vlax-make-variant obj vlax-vbObject)
                                                                        )
                                                                        lst_ename
                                                )
                        )
                        ;创建一个空的数组
                        (setq arr (vlax-make-safearray vlax-vbobject (cons 0 (- (length lst_var) 1))))
                        ;表装入数组
                        (setq arr (vlax-safearray-fill arr lst_var))
                        ;将数组对象复制到块内
                        (vla-CopyObjects obj_doc arr obj_block)
                        (if dele
                                (progn
                                        ;删除原有的对象
                                        (mapcar '(lambda(y)
                                                                (entdel y)
                                                        )
                                                                lst_ename
                                        )
                                )
                        )
                        (if in_pt
                                (progn
                                        ;插入in_pt插入这个块
                                        (vla-InsertBlock modspe (vlax-3D-point in_pt) name 1 1 1 0)
                                )
                                obj_block
                        )
                )
        )
)

tomonkey239 发表于 2022-10-8 08:33:11

学习了，感谢分享，大佬

yhly555 发表于 2024-7-29 21:47:01

厉害，感谢分享！
页: [1]
查看完整版本: Vlisp的方法创建一个块，返回OBJ对象