[求助]如何快速创建有名块呀？

xtjefhw · 发表于 2009-6-17 20:17:00

如何快速创建有名块呀？能不能把下面两个合成一个

(defun C:za (/ E)
(mc-make-unname-block (ssget))
(princ)
)

(defun mc-make-unname-block(ss / count entlist ent blk)

(entmake '((0 . "BLOCK")
   (2 . "*u")
     (70 . 1)
     (10 0 0 0)
     ))
(setq count 0)
(repeat (sslength ss)
    (setq entlist(entget(setq ent(ssname ss count))))
    (setq count (1+ count))
    (entmake entlist)
    )
(setq count 0)
(repeat(sslength ss)
    (setq ent(ssname ss count))
    (setq count (1+ count))
    (entdel ent)
    )
(setq blk(entmake '((0 . "ENDBLK"))))
(if (princ blk)
(entmake (list (cons 0 "INSERT")
     (cons 2 blk)
     (cons 10 '(0 0 0))
     ))
    )
blk
)

(defun C:ccc (/ *APP *DOC EntNam NewNam)
(vl-load-com)

    (setq *APP (vlax-get-acad-object))
    (setq *DOC (vla-get-activeDocument *APP))
    (if (setq EntNam (car (entsel "\n请选择块: ")))
       (if (null (tblobjname "block" (setq NewNam (rtos (txt-rnd)))))
        (change-block-name EntNam NewNam)
        (princ "\n你没有输入新块名!")
      )
      (princ "\n你没有选择物体!")
    )
    (princ)
)
;;;改块名程序
(defun change-block-name (EntNam NewNam / obj blocks BlkNam block)
    (setq obj (vlax-ename->vla-object EntNam))
    (setq blocks (vla-get-blocks *DOC))
    (if (=(vla-get-objectname obj) "AcDbBlockReference")
      (if (tblsearch "block" NewNam)
        (princ "\n和已有块名重复!")
        (progn
          (setq BlkNam (vla-get-name obj))
          (setq block (vla-item blocks BlkNam))
          (vla-put-name block NewNam)
          (if (= (substr BlkNam 1 2) "*U")
            (progn
              (princ "\n这是一个匿名块.")
              (vla-auditinfo *Doc :vlax-true)
              (vla-put-name block NewNam)
            )
          )
          (princ "\n块名已经更改成\"")
          (princ NewNam)
          (princ "\"")
        )
      )
      (princ "\n所选物体不是块!")
    )
)

(defun txt-rnd () ; 随机名字

(* (rem (getvar "cputicks") 213) 100)
)

ZZXXQQ · 发表于 2009-6-17 22:26:00

(defun c:tt ()
(setvar "CMDECHO" 0)
(if (and (princ "\n选择建块图元 :")
(setq ss (ssget))
(setq pt (getpoint "\n图块插入点 :"))
(setq bnm (getstring "\n块名 :")))
(command "-block" bnm pt ss)
)
(setvar "CMDECHO" 1)
(princ)
)

ttsmile · 发表于 2009-6-17 22:45:00

用二楼的代码，创建完了块，但是块本身不显示，不知道为什么啊？

totoro · 发表于 2009-6-17 23:07:00

此程序使用选定的对象、插入基准点与提供的名称来定义图块，然后从图面中删除选定的对象。在运行 BLOCK 命令之后，立即输入 OOPS 可以还原删除的对象。

ttsmile · 发表于 2009-6-17 23:10:00

那怎么做成块后让块不消失呢？

xtjefhw · 发表于 2009-6-18 00:17:00

怎么做才能不消失呀只是转换为块呀，或者消失了，怎样插入比较简单，刚学不是很明白，能不能说明白上点

(defun c:tt ()
(setvar "CMDECHO" 0)
(if (and (princ "\n选择建块图元 :")
          (setq ss (ssget))
         (setq pt (list 0 0))
          (setq bnm (rtos (txt-rnd))))
(command "-block" bnm pt ss)
)
(setvar "CMDECHO" 1)

(princ)
)

(defun txt-rnd () ; 随机名字

(* (rem (getvar "cputicks") 213) 100)
)

totoro · 发表于 2009-6-18 01:09:00

如我所说-block制作成图块后,图形会删除~
只要在插入图快就行了~
修改如下~

(defun c:tt ()
(setvar "CMDECHO" 0)
(if (and (princ "\n选择建块图元 :")
(setq ss (ssget))
(setq pt (getpoint "\n图块插入点 :"))
(setq bnm (getstring "\n块名 :")))
(command "-block" bnm pt ss "" "-insert" bnm pt "" "" "")
)
(setvar "CMDECHO" 1)
(princ)
)

xtjefhw · 发表于 2009-6-18 07:05:00

多谢高手高招，终于拔开青天见月明了，这个问题困扰我三天了，在百度左搜右搜，都是些做无名块的，但无名块不能直接编辑，还得转有名块，相当于直接做有名块的麻烦。再次感谢高手，我还有个想法：

我们一般一个产品投影出来至少三个视图，视图与视图之间都会有个不太小的距离，能不能框选所有视图，自动判断这个比较模糊的距离(好像这个判断，比较麻烦，不知道能不能成立)

然后添加至选择集1,2,3~~~，用循环函数比如其它语言的　IF GOTO　for do loop,　批量创建块，

块名随机名，插入点0点关系也不会很大为了代码简单。一个框选搞掂一切，期待高手出招吧

peter-wen · 发表于 2013-12-20 00:06:07

最近想写个属性块，偷师来了。谢谢各位前辈。

账号		自动登录	找回密码
密码			注册

[求助]如何快速创建有名块呀？

浏览过的版块