圆心插入块

荒野孤行

此程序对于画上下治具套合孔位特别好用。（如果之前都是用块来画孔位的则不需考虑此程序，直接修改图块即可。这个是用来收拾老设计员的烂摊子的），演示见图片吧！演示中用到了WDY工具箱（若需下载，请见我的个人签名）中的命令（如命令“XS”，即“图层显示”功能）

若是需在交点插块（块的基点最好在块内图元的中心，否则插入到圆心位置后是偏的，可以自行测试），之前亦发表在论坛上了，网址：http://bbs.mjtd.com/thread-168426-1-1.html
若需在曲线固定点/顶点上插块图块，按照这两个自行修改吧！
不废话了，丢出源码：


;;;圆心插块
(princ "\n调用命令：ck\n")
(defun c:ck (/ ss yuanxinlist)
  (setvar "cmdecho" 0)
  (vl-load-com)
  (setvar "osmode" 15359)
  (princ
    "\n★功能：在批量选取的圆的圆心处插入块。\n提示：在执行此功能前请确定图块的基点是否在其

中心位置，否则会出现插入点偏位现象。\n"
  )
  (princ "\n请选择要在圆心处插入块的圆或圆弧：")
  (command "undo" "be")
  (if (not (setq ss (ssget '((0 . "ARC,CIRCLE")))))
    (progn (princ "\n提示：未选取图元，程序退出。\n") (exit))
  )
  (setq i 0)
  (repeat (sslength ss)
    (setq ent          (entget (ssname ss i))
          yuanxin (cdr (assoc 10 ent))
    )
    (setq yuanxinlist (cons yuanxin yuanxinlist))
    (setq i (1+ i))
  )
  (setq atcad (vlax-get-acad-object))
  (setq acaddocument (vla-get-activedocument atcad))
  (setq mspace (vla-get-modelspace acaddocument))
  (while
    (progn (setq blockent     (entsel "\n请选择要插入至交点处的图块：")
                 blockentname (car blockent)
           )
           (not        (if (= blockent nil)
                  nil
                  (= (cdr (assoc 0 (entget blockentname))) "INSERT")
                )
           )
    )
     (princ
       "\n提示：选取的不是图块或未选取任何图元,请重新选取："
     )
  )
(setq blockname (cdr (assoc 2 (entget blockentname))))
  (initget 6)
  (if (not (setq bili (getreal "\n插入比例<1.0>")))
    (setq bili 1.0)
  )
  (setvar "osmode" 0)
  (foreach pt yuanxinlist
    (vla-insertblock
      mspace
      (vlax-3d-point pt)
      blockname
      bili
      bili
      bili
      0
    )
  )
  (command "undo" "e")
  (setvar "osmode" 15359)
  (princ)
)

xiaozhu33033

大佬，我复制了代码，可是输入CK软件都没识别啊，软件已经加载了，可是没反应


没事了，要另存ANSI格式，是我操作不当

ywx2020

这个代码可以啊，太长了，很多都看不到。我想找一些简单点，一次插入一个那种

xman00

请问能否来个批量以A块（点选）的插入点插入B块（点选）的程序呢？

尒樣僮

我是新人，好东西学习一下

pengfei2010

回帖是一种美德！感谢楼主的无私分享 谢谢

xfjiamy

不错的程序，我喜欢

start4444

qq84603709

支持~~~~~~~~~~~~~

有空我就来

谢谢分享 谢谢分享 谢谢分享