本帖最后由 wowan1314 于 2012-12-13 20:10 编辑
这个程序到此为止了。
感觉实际使用要比G的好用点（尽管速度慢点）
1、省略25米的输入，按S才出现。省了一步操作
2、加入删圆的操作。默认不删圆。按D才删圆。看着更直观。
3、加入状态栏进度条，使用过程更友好。
具体操作步骤
1、选块
2、暂停观察 。
2.1按S可设置半径，然后结束程序删除过程物。下次运行按新半径计算
2.2按D可删除圆，然后暂停，仅剩余填充及填充边界，方便更好的观察。
再按鼠标左右键结束程序删除过程物
2.3按鼠标左右键结束程序删除过程物。
对单个及一个交集没有的情况下会填充某一个。 不过实际中也不会有这个情况。
wowan1314 发表于 2012-12-12 19:37 static/image/common/back.gif
这个程序到此为止了。
感觉实际使用要比G的好用点（尽管速度慢点）
朋友，能增加图块识别选项吗？仅放到选项里，特殊情况选取需要识别的图块（有时候要看灭火器的保护半径，图块名称不一样）
本帖最后由 wowan1314 于 2012-12-13 16:02 编辑
是把第一步改为先选块确定块名再选范围。还是把选块得块名这步也放选项里面
本帖最后由 阿然 于 2012-12-13 17:30 编辑
虽然解决了，附上我按照gu版给的思路写的代码，争取顶到50楼看看GU版的代码。输入消防栓块名（可以使用*来代替尾数，比如j_xhs*），输入半径，框选，然后有结果 (vl-load-com)
(setvar "cmdecho" 0)
(setq *AcadDoc* (vla-get-ActiveDocument (vlax-get-Acad-Object)))
(setq *MoSpace* (vla-get-ModelSpace *AcadDoc*))
(defun c:test (/ ss blockname blocklist
ocirlist regionlist blocklengthi
j tempregion1 tempregion2intersectlist
intersectregion ocir oregion
cenptlist pt hatchlist ohatch
code
)
(if (and
(setq blockname (getstring "\n请输入块名:"))
(setq CenRad (getreal "\n请输入圆半径:"))
(setq ss (ssget "_W"
(setq pt (getpoint "\n选取第一点:"))
(getcorner pt "\n选取第二点:")
(list
'(0 . "INSERT")
(cons 2 blockname)
)
)
)
)
(progn
(setq blocklength
(sslength ss)
i 0
)
(while (< i blocklength)
(setq blocklist (cons (ssname ss i) blocklist)
i (1+ i)
)
)
(setq ss nil)
(setq
cenptlist (mapcar '(lambda (x)
(cdr (assoc 10 (entget x)))
)
blocklist
)
)
(setq ocirlist
(mapcar '(lambda (x)
(vla-addCircle *mospace* (vlax-3d-point x) cenrad)
)
cenptlist
)
)
(setq regionlist
(vlax-safearray->list
(vlax-variant-value
(vla-addregion
*mospace*
(Xr:list->Obj-Array ocirlist)
)
)
)
i 0
)
(while (< i blocklength)
(setq j (1+ i))
(while (< j blocklength)
(setq tempregion1
(vlax-invoke-method (nth i regionlist) 'Copy)
tempregion2
(vlax-invoke-method (nth j regionlist) 'Copy)
)
(vlax-invoke-method
tempregion1
'Boolean
1
tempregion2
)
(if (not (equal
(vlax-get-property tempregion1 'Area)
0.0
0.000001
)
)
(progn
(setq intersectlist (cons tempregion1 intersectlist))
(if (not (vlax-erased-p tempregion2))
(vla-erase tempregion2)
)
)
(progn
(if (not (vlax-erased-p tempregion1))
(vla-erase tempregion1)
)
(if (not (vlax-erased-p tempregion2))
(vla-erase tempregion2)
)
)
)
(setq j (1+ j))
)
(setq i (1+ i))
)
(setq
hatchlist (mapcar '(lambda (x) (Xr:addhatch x)) intersectlist)
)
;;; (vlax-invoke-method *acaddoc* 'Regen 0)
;;; (prompt "\n按回车结束!")
;;; (while (equal
;;; (setq code (grread T 8))
;;; '(2 13)
;;; )
;;; )
;;; (Xr:delete (append hatchlist intersectlist regionlist ocirlist))
)
)
(princ)
)
(defun Xr:addhatch (obj / ohatch)
(setq ohatch (vla-AddHatch *mospace* 0 "ANSI31" T))
(vlax-invoke-method
ohatch
'AppendOuterLoop
(Xr:list->Obj-Array (list obj))
)
ohatch
)
(defun Xr:delete (objlist / obj)
(foreach obj objlist
(if (not (vlax-erased-p obj))
(vla-erase obj)
)
)
)
(defun Xr:list->Obj-Array (objList / arraySpace sArray)
(setq arraySpace
(vlax-make-safearray
vlax-vbObject ; 元素类型
(cons 0
(1- (length objList))
) ; 数组维数
)
)
(setq sArray (vlax-safearray-fill arraySpace objList))
)
wowan1314 发表于 2012-12-13 13:37 static/image/common/back.gif
是把第一步改为先选块确定块名再选范围。还是把选块得块名这步也放选项里面
选块得块名这步放选项里面比较好，默认操作顺序不变，输入关键词才进入“选块得块名”这一步
嗯。
1、可根据不同的块名来提示程序要检查的是消火栓还是灭火器，这样更人性化
2、如果是灭火器多数情况下是多少半径？ 直接在程序中默认下，省的输入。特殊情况再输入
本帖最后由 wuqiu1986 于 2012-12-13 19:48 编辑
自己做了一个，感觉速度有点慢，不过应该满足要求，由于有急事，没来得及做图片。命令是gxfs，选取一个消防栓样本，目的在于消防栓块以后改名也能用，然后是半径，然后选择，可以自动全选，任意键退出。还是个初学者，程序有待提高。
本帖最后由 wowan1314 于 2013-6-8 11:19 编辑
奇怪了。VLA代码怎么那么长啊。看不下去。
下面是按楼主意思修改的。
1、程序根据块名不同提示选择消火栓OR灭火器
2、加入选块得块名选项。
3、状态栏进度条简化下，少用个循环，免得使本来就不快的程序变的更慢
4、小技巧，若想留圆及填充按ESC即可。
5、程序写的很乱，就不拿出来丢人了。实现功能就好。
wowan1314 发表于 2012-12-13 19:58 static/image/common/back.gif
奇怪了。VLA代码怎么那么长啊。看不下去。
下面是按楼主意思修改的。
1、程序根据块名不同提示选择消火栓 ...
这样更实用了，如果图纸不是很大，跟G版的速度也差不了多少，呵呵，非常感谢大家！