明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 45312|回复: 261

[源码] 批量交点插入块

    [复制链接]
发表于 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")
                )
           )
    )
(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)
  (setq ptlist (ssinters ss))
  (foreach pt ptlist
    (vla-insertblock
      mspace
      (vlax-3d-point pt)
      blockname
      bili
      bili
      bili
      0
    )
  )
  (command "undo" "e")
  (setvar "osmode" 15359)
  (princ)
)

(defun ssinters        (ss / i num obj1 obj2 j interpts ptlist)
  (setq        i   0
        num (sslength ss)
  )
  (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
)
;;;*****交点插块 程序结束*****

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x

评分

参与人数 6明经币 +5 金钱 +15 收起 理由
忙出一个未来 + 1 + 5 很给力!
qm7872728 + 10
skg123 + 1 赞一个!
ucuc2003 + 1 赞一个!
flytoday + 1 很给力!
USER2128 + 1 赞一个!

查看全部评分

"觉得好,就打赏"
还没有人打赏,支持一下
发表于 2016-10-12 17:01:28 | 显示全部楼层
楼主,不足之处就是,如果交点处是断开的直线,插入块时会插入2个块,比如十字形的交点,如果2条直线在交点处是断开的,在十字中心就会插入2个块
发表于 2019-9-6 08:43:12 | 显示全部楼层
感谢分享,一直想找个批量把文字处插入块,看这个能不能实现!
发表于 2018-9-28 11:06:50 | 显示全部楼层
如果要是能自动删除重复坐标的图块,那就更完美了
发表于 2015-6-10 04:23:22 | 显示全部楼层
感谢 荒野孤行 分享程序!
发表于 2015-6-10 07:08:28 | 显示全部楼层
本帖最后由 iszc 于 2015-6-10 07:13 编辑

感谢分享            
发表于 2015-6-10 07:15:18 | 显示全部楼层
看一看,学一学。
发表于 2015-6-10 07:28:47 | 显示全部楼层
下载收藏,谢谢荒野孤行
发表于 2015-6-10 07:30:08 | 显示全部楼层
感谢分享原码
发表于 2015-6-10 07:55:45 | 显示全部楼层
感谢 荒野孤行 感谢分享程序!
发表于 2015-6-10 08:08:10 | 显示全部楼层
这是在画太阳啊
发表于 2015-6-10 08:13:01 | 显示全部楼层
学习学习学习学习
发表于 2015-6-10 08:24:50 | 显示全部楼层
支持一下哦
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-11-23 07:43 , Processed in 0.198143 second(s), 34 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表