批量交点插入块（支持选块样板，多段线、曲线、直线）

【KAIXIN】 · 发表于 2011-12-14 13:07

本帖最后由【KAIXIN】于 2011-12-17 16:03 编辑

ㄘ丶转裑ㄧ灬 · 发表于 2015-12-25 13:27

hehoubin 发表于 2012-11-18 00:21
能放子程序SSINTERS的源码吗

(defun ssinters (ss / pts en1 en2)
(while (> (sslength ss) 1)
(setq en1 (ssname ss 0))
(ssdel en1 ss)
(setq n (sslength ss))
(repeat n
(setq en2 (ssname ss (setq n (1- n))))
(setq pts (append pts (Curveinters en1 en2)))
)
)
pts
)
(defun Curveinters (en1 en2 / pl pts)
(setq pl (vlax-invoke (vlax-ename->vla-object en2) 'IntersectWith (vlax-ename->vla-object en1) acExtendNone))
(while pl
(setq pts (append pts (list (list (car pl) (cadr pl) (caddr pl))))
pl (cdr (cdr (cdr pl)))
)
)
pts
)

【KAIXIN】 · 发表于 2011-12-17 16:07

半片香发表于 2011-12-17 15:51
讲多句，楼主无形中帮助搞定了一个大工程问题，
小可是施工单位做深化设计的，属于参数化建筑最底层一环， ...

嗯，不用客气！我也知道这个程序可以帮助很多人！因为大家一直在提问这个程序！

就是因为可以帮助人，我才.....

因其实这个对我自己一点用也没有！

程序已更新！可以保留你的捕捉，欢迎试试！

流动的清泉 · 发表于 2023-11-1 19:37

这个源码好像和你的不完全一样
(defun c:t1 ()

(vl-load-com)
(setq cmd (getvar "cmdecho"))
(setvar "cmdecho" 0 )
(setq blockent (ssname (ssget ＂L＂) 0))
(command "select" "")

  (setvar "osmode" 15359)
  (princ "\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))

  (setq blockname (cdr (assoc 2 (entget blockent))))
  (setq blockX (cdr (assoc 41 (entget blockent))))

  (setvar "osmode" 0)
  (setq ptlist (ssinters ss))
  (foreach pt ptlist
(vla-insertblock
   mspace
   (vlax-3d-point pt)
   blockname
   blockX
   blockX
   blockX
   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
)

【KAIXIN】 · 发表于 2011-12-14 13:23

占个位置

1548845899 · 发表于 2011-12-14 14:06

提示: 作者被禁止或删除内容自动屏蔽

500w008 · 发表于 2011-12-14 17:39

提示: 作者被禁止或删除内容自动屏蔽

display18 · 发表于 2011-12-14 19:25

很好的......

【KAIXIN】 · 发表于 2011-12-14 19:26

500w008 发表于 2011-12-14 17:39
顶下有了顶下有了

多多支持，好程序不断！

完整武器 · 发表于 2011-12-14 19:54

本帖最后由完整武器于 2011-12-14 19:56 编辑

不错收藏好该用的时候就可以拿出来了

kwok · 发表于 2011-12-15 10:52

支持一下...

半片香 · 发表于 2011-12-17 10:48

超级好用，但是发现问题：

1、如果变换为UCS的话，插入块有问题
2、如果一张图里要插入两种块，，它搞不定

【KAIXIN】 · 发表于 2011-12-17 10:53

半片香发表于 2011-12-17 10:48
超级好用，但是发现问题：

1、如果变换为UCS的话，插入块有问题

这个程序是读取所有交点，用块的基点插入，跟UCS没有关系

也就是说：插入后，块的基点就是交点，不知你的是什么情况？

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

批量交点插入块（支持选块样板，多段线、曲线、直线）

本帖子中包含更多资源

点评

评分

相关帖子

1548845899 1548845899 当前离线积分 1588 明经币个注册时间 2010-11-12 在线时间小时威望金钱个贡献激情	发表于 2011-12-14 14:06 \| 显示全部楼层提示: 作者被禁止或删除内容自动屏蔽

	回复支持反对使用道具举报显身卡

500w008 500w008 当前离线积分 6427 明经币个注册时间 2009-9-28 在线时间小时威望金钱个贡献激情	发表于 2011-12-14 17:39 \| 显示全部楼层提示: 作者被禁止或删除内容自动屏蔽

	回复支持反对使用道具举报显身卡