【求助】批量外部块对象选择问题
 

【求助】批量外部块对象选择问题
www.dimcax.com
【求助】批量外部块对象选择问题
我希望能编一个批量写外部块的功能，原来的可以使用只是写出来的外部块的插入点离图元很远，现在我想修改能让插入点控制在图元的范围内（开始是想能控制在质心，但不成面域的多个环形不知道怎么弄，水平问题），但是我参考各位高手的代码写出来的代码有问题，图元选择出现了错误，请高手们指点，谢谢！
[code]
;选择图中所有图元并获得外轮廓的两角点
(setq ss (ssget "x"))
(setq obj (vlax-ename->vla-object ss))
(vla-getboundingbox obj "p1" "p2")
;取得中点
(setq p1_x (car p1))
(setq p2_x (car p2))
(setq p1_y (cadr p1))
(setq p2_y (cadr p2))
(setq p_x (+ (/ (- p1_x p2_x) 2) p2_x))
(setq p_y (+ (/ (- p1_y p2_y) 2) p2_y))
(setq p_new (list p_x p_y 0))
;以中点写外部块
(command "wblock" (strcat path "\\" "1" "\\" name) "" p_new obj "")
[code]
d
好像vla-getboundingbox命令只能对一个图元进行操作，是这样的吗？
d
这是全部代码，但是执行有问题，那位高手可以帮我看一下啊？谢谢了
;尝试能在图块的中心写外部块
(defun c:b6 (/ path #time time-1 fn n name time-2 time-last ss idx count en entall)
(vl-load-com)
(setq path (getstring "\n请指定 dwg 文件目录:"))
(princ "\n 正在处理,等一下...")
(princ)
(setq cmdecho-save (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq #time (getvar "date")) ;time1
(setq time1 (* 86400.0 (- #time (fix #time)))) ;time1
(setq fn (open (strcat path "\\" "namelist.txt") "a"))
(setq n 0)
(foreach name (vl-directory-files path nil 1)
(if (= (strcase (vl-filename-extension name) t) ".dwg")
(progn
;*******************************************************************
;插入块
(vl-cmdf "-insert" (strcat path "\\" name) '(0 0 0)"""""")
;*******************************************************************
;炸开块
(setq ss (ssget "x" '((0 . "insert"))))
;选择图中所有图元并获得外轮廓的两角点
; (setq ss (ssget "x"))
(setq obj (vlax-ename->vla-object ss))
(vla-getboundingbox obj "minp" "maxp")
(setq p1 (vlax-safearray->list minp)
p2 (vlax-safearray->list maxp));查询返回值
;取得中点
(setq p1_x (car p1))
(setq p2_x (car p2))
(setq p1_y (cadr p1))
(setq p2_y (cadr p2))
(setq p_x (+ (/ (- p1_x p2_x) 2) p2_x))
(setq p_y (+ (/ (- p1_y p2_y) 2) p2_y))
(setq p_new (list p_x p_y 0))
(setq idx -1 count 0)
(if ss
(while (<= (setq idx (1+ idx)) (1- (sslength ss)))
(setq en (ssname ss idx))
(if (not (assoc 1 (tblsearch "block"
(cdr (assoc 2 (entget en))))))
(progn
(command "explode" en)
(setq count (1+ count))
)
);endif
)
)
(princ (strcat "\n" (itoa count)
" block(s) exploded."))
(princ)
;*******************************************************************
;以中点写外部块
(setq ss (ssget "x"))
(command "wblock" (strcat path "\\" "1" "\\" name) "" p_new obj "")
;*******************************************************************
;删除图
(vl-cmdf "erase" "all" "")

)
)
)
)
d
vla-getboundingbox命令只能对一个图元进行操作，我想在块还没有炸开的时候就获取点，但到了点的处理的时候出现了问题，那位高手给指点一下呢？
下面是我的代码
;尝试能在图块的中心写外部块
(defun c:b6 (/ path #time time-1 fn n name time-2 time-last ss idx count en entall)
(vl-load-com)
(setq path (getstring "\n请指定 dwg 文件目录:"))
(princ "\n 正在处理,等一下...")
(princ)
(setq cmdecho-save (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq #time (getvar "date")) ;time1
(setq time1 (* 86400.0 (- #time (fix #time)))) ;time1
(setq fn (open (strcat path "\\" "namelist.txt") "a"))
(setq n 0)
(foreach name (vl-directory-files path nil 1)
(if (= (strcase (vl-filename-extension name) t) ".dwg")
(progn
;*******************************************************************
;插入块
(vl-cmdf "-insert" (strcat path "\\" name) '(0 0 0)"""""")
;*******************************************************************
;炸开块
(setq ss (ssget "x" '((0 . "insert"))))
(setq idx -1 count 0)
(if ss
(while (<= (setq idx (1+ idx)) (1- (sslength ss)))
(setq en (ssname ss idx))
(if (not (assoc 1 (tblsearch "block" (cdr (assoc 2 (entget en))))))
(progn
;选择图中块外轮廓的两角点
(vla-getboundingbox en "minp" "maxp")
(setq p1 (vlax-safearray->list minp)
p2 (vlax-safearray->list maxp));查询返回值
;取得中点
(setq p1_x (car p1))
(setq p2_x (car p2))
(setq p1_y (cadr p1))
(setq p2_y (cadr p2))
(setq p_x (+ (/ (- p1_x p2_x) 2) p2_x))
(setq p_y (+ (/ (- p1_y p2_y) 2) p2_y))
(setq p_new (list p_x p_y 0))
(command "explode" en)
(setq count (1+ count))
)
);endif
)
)
(princ (strcat "\n" (itoa count)
" block(s) exploded."))
(princ)
;*******************************************************************
;以中点写外部块
(setq ss (ssget "x"))
(command "wblock" (strcat path "\\" "1" "\\" name) "" p_new ss "")
;*******************************************************************
;删除图
(vl-cmdf "erase" "all" "")

)
)
)
)
d
怎么没有人理呢？
d
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
( c:b6 ( blk_bound cmdecho-save mpt path ss)
()
( path ( "\n請指定 dwg 文件目錄:")) ;k:\temp
( "\n 正在處理,等一下...")
()
( cmdecho-save ( "cmdecho"))
( "cmdecho" 0)
( name ( path "*.dwg" 1)
( "_.insert"
( path "\\" name)
'(0 0 0)
""
""
""
)
( "_.explode" ())
( "_.zoom" "e")
( ss ( "p"))
( blk_bound (acet-geom-ss-extents ss t))
( mpt ( '/
( '+ ( blk_bound) ( blk_bound))
'(2.0 2.0 2.0)
)
)
( "_.wblock"
( path "\\" "1-" name)
""
"non"
mpt
ss
""
)
( "_.purge" "b" "*" "n")
)
( "cmdecho" cmdecho-save)
()
)
要努力学习,不进则退
网络u盘：://free.ys168.com/?lucas-lai