荒野孤行 发表于 2015-6-10 00:04:19

批量交点插入块

本帖最后由 荒野孤行 于 2015-6-14 10:29 编辑

程序源码是根据论坛的源码改的，论坛的写的太散乱了，以下源码直接下载就可以用。已重新根据坛友的代码进行了修改。

;;;*****交点插块 程序开始*****
(defun c:t1 ()
(setvar "cmdecho" 0)
(vl-load-com)
(setvar "osmode" 15359)
(princ
    "\n★功能：在批量图元的相交点处插入块。\n提示：在执行此功能前请确定图块的基点是否在其中心位置，否则会出现插入点偏位现象。\n"
)
(princ "\n请选择多段线、样条曲线、直线、圆、圆弧或椭圆：")
(command "undo" "be")
(if (not (setq ss (ssget '((0 . "*LINE,ARC,CIRCLE,ELLIPSE")))))
    (progn (princ "\n提示：未选取图元，程序退出。\n") (exit))
)
(setq acad (vlax-get-acad-object))
(setq acaddocument (vla-get-activedocument acad))
(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")
                )
         )
    )
**** Hidden Message *****
(while (< i (1- num))
    (setq obj1 (ssname ss i)
          obj1 (vlax-ename->vla-object obj1)
          j    (1+ i)
    )
    (while (< j num)
      (setq obj2   (ssname ss j)
            obj2   (vlax-ename->vla-object obj2)
            interpts (vla-intersectwith
                     obj1
                     obj2
                     0
                     )
            interpts (vlax-variant-value interpts)
      )
      (if (> (vlax-safearray-get-u-bound interpts 1) 0)
      (progn
          (setq      interpts
               (vlax-safearray->list interpts)
          )
          (while (> (length interpts) 0)
            (setq ptlist (cons (list (car interpts)
                                     (cadr interpts)
                                     (caddr interpts)
                               )
                               ptlist
                         )
            )
            (setq interpts (cdddr interpts))
          )
      )
      )
      (setq j (1+ j))
    )
    (setq i (1+ i))
)
ptlist
)
;;;*****交点插块 程序结束*****

wx302008008 发表于 2016-10-12 17:01:28

楼主，不足之处就是，如果交点处是断开的直线，插入块时会插入2个块，比如十字形的交点，如果2条直线在交点处是断开的，在十字中心就会插入2个块

wwchlncad 发表于 2019-9-6 08:43:12

感谢分享，一直想找个批量把文字处插入块，看这个能不能实现！

20060510412 发表于 2018-9-28 11:06:50

如果要是能自动删除重复坐标的图块，那就更完美了

yoyoho 发表于 2015-6-10 04:23:22

感谢 荒野孤行 分享程序!

iszc 发表于 2015-6-10 07:08:28

本帖最后由 iszc 于 2015-6-10 07:13 编辑

感谢分享            

dbqtju 发表于 2015-6-10 07:15:18

看一看，学一学。

Linhay 发表于 2015-6-10 07:28:47

下载收藏,谢谢荒野孤行

十二台兄 发表于 2015-6-10 07:30:08

感谢分享原码

USER2128 发表于 2015-6-10 07:55:45

感谢 荒野孤行 感谢分享程序!

lucas_3333 发表于 2015-6-10 08:08:10

这是在画太阳啊

vectra 发表于 2015-6-10 08:13:01

学习学习学习学习

LIULISHENG 发表于 2015-6-10 08:24:50

支持一下哦
页: [1] 2 3 4 5 6 7 8 9 10
查看完整版本: 批量交点插入块