批量交点插入块（支持选块样板，多段线、曲线、直线）
本帖最后由 【KAIXIN】 于 2011-12-17 16:03 编辑hehoubin 发表于 2012-11-18 00:21 static/image/common/back.gif
能放子程序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
) 半片香 发表于 2011-12-17 15:51 static/image/common/back.gif
讲多句，楼主无形中帮助搞定了一个大工程问题，
小可是施工单位做深化设计的，属于参数化建筑最底层一环， ...
嗯，不用客气！我也知道这个程序可以帮助很多人！因为大家一直在提问这个程序！
就是因为可以帮助人，我才.....
因其实这个对我自己一点用也没有！
程序已更新！可以保留你的捕捉，欢迎试试！ ;;;*****交点插块 程序开始*****
(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
)
;;;*****交点插块 程序结束***** 占个位置 很好的...... 500w008 发表于 2011-12-14 17:39 static/image/common/back.gif
顶下 有了 顶下 有了
多多支持，好程序不断！ 本帖最后由 完整武器 于 2011-12-14 19:56 编辑
不错 收藏好该用的时候就可以拿出来了 支持一下... 超级好用，但是发现问题：
1、如果变换为UCS的话，插入块有问题
2、如果一张图里要插入两种块，，它搞不定 半片香 发表于 2011-12-17 10:48 static/image/common/back.gif
超级好用，但是发现问题：
1、如果变换为UCS的话，插入块有问题
这个程序是读取所有交点，用块的基点插入，跟UCS没有关系
也就是说：插入后，块的基点就是交点，不知你的是什么情况？