编程申请：以块中心画直径为25米的圆，圆的交集内填充阴影或颜色，鼠标左键单击退出…

wowan1314 · 发表于 2012-12-12 19:37:08

本帖最后由 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:47:33

对单个及一个交集没有的情况下会填充某一个。不过实际中也不会有这个情况。

半听可乐 · 发表于 2012-12-13 09:47:40

wowan1314 发表于 2012-12-12 19:37
这个程序到此为止了。

感觉实际使用要比G的好用点（尽管速度慢点）

朋友，能增加图块识别选项吗？仅放到选项里，特殊情况选取需要识别的图块（有时候要看灭火器的保护半径，图块名称不一样）

wowan1314 · 发表于 2012-12-13 13:37:09

本帖最后由 wowan1314 于 2012-12-13 16:02 编辑

是把第一步改为先选块确定块名再选范围。还是把选块得块名这步也放选项里面

阿然 · 发表于 2012-12-13 17:26:09

本帖最后由阿然于 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 blocklength i
j tempregion1 tempregion2 intersectlist
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))
)

(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         blocklength  i 
               j            tempregion1         tempregion2  intersectlist 
               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 (
        (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 (
        (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)) 
)

半听可乐 · 发表于 2012-12-13 17:45:05

wowan1314 发表于 2012-12-13 13:37
是把第一步改为先选块确定块名再选范围。还是把选块得块名这步也放选项里面

选块得块名这步放选项里面比较好，默认操作顺序不变，输入关键词才进入“选块得块名”这一步

wowan1314 · 发表于 2012-12-13 19:29:34

嗯。
1、可根据不同的块名来提示程序要检查的是消火栓还是灭火器，这样更人性化
2、如果是灭火器多数情况下是多少半径？直接在程序中默认下，省的输入。特殊情况再输入

wuqiu1986 · 发表于 2012-12-13 19:33:57

本帖最后由 wuqiu1986 于 2012-12-13 19:48 编辑

自己做了一个，感觉速度有点慢，不过应该满足要求，由于有急事，没来得及做图片。命令是gxfs，选取一个消防栓样本，目的在于消防栓块以后改名也能用，然后是半径，然后选择，可以自动全选，任意键退出。还是个初学者，程序有待提高。

wowan1314 · 发表于 2012-12-13 19:58:02

本帖最后由 wowan1314 于 2013-6-8 11:19 编辑

奇怪了。VLA代码怎么那么长啊。看不下去。
下面是按楼主意思修改的。
1、程序根据块名不同提示选择消火栓OR灭火器
2、加入选块得块名选项。
3、状态栏进度条简化下，少用个循环，免得使本来就不快的程序变的更慢
4、小技巧，若想留圆及填充按ESC即可。
5、程序写的很乱，就不拿出来丢人了。实现功能就好。

半听可乐 · 发表于 2012-12-14 09:17:53

wowan1314 发表于 2012-12-13 19:58
奇怪了。VLA代码怎么那么长啊。看不下去。
下面是按楼主意思修改的。
1、程序根据块名不同提示选择消火栓 ...

这样更实用了，如果图纸不是很大，跟G版的速度也差不了多少，呵呵，非常感谢大家！

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

编程申请：以块中心画直径为25米的圆，圆的交集内填充阴影或颜色，鼠标左键单击退出…

本帖子中包含更多资源

评分

本帖子中包含更多资源

点评

本帖子中包含更多资源

本帖子中包含更多资源

评分

点评