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

congcong96 发表于 2008-11-6 09:39:00

我希望能编一个批量写外部块的功能，原来的可以使用只是写出来的外部块的插入点离图元很远，现在我想修改能让插入点控制在图元的范围内（开始是想能控制在质心，但不成面域的多个环形不知道怎么弄，水平问题），但是我参考各位高手的代码写出来的代码有问题，图元选择出现了错误，请高手们指点，谢谢！ ;选择图中所有图元并获得外轮廓的两角点 (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 "")

congcong96 发表于 2008-11-7 08:37:00

好像vla-GetBoundingBox命令只能对一个图元进行操作，是这样的吗？

congcong96 发表于 2008-11-7 11:43:00

这是全部代码，但是执行有问题，那位高手可以帮我看一下啊？谢谢了 ;尝试能在图块的中心写外部块 (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" "") ) ) ) )

congcong96 发表于 2008-11-8 14:40:00

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" "") 
 
 ) 
) 
) 
)

congcong96 发表于 2008-11-10 16:42:00

怎么没有人理呢？

龙龙仔 发表于 2008-11-11 07:52:00

(defun C:B6 (/ BLK_BOUND CMDECHO-SAVE MPT PATH SS)
(vl-load-com)
(setq PATH (getstring "\n請指定 DWG 文件目錄:")) ;k:\temp
(princ "\n 正在處理,等一下...")
(princ)
(setq CMDECHO-SAVE (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(foreach NAME (vl-directory-files PATH "*.dwg" 1)
(command "_.insert"
   (strcat PATH "\\" NAME)
   '(0 0 0)
   ""
   ""
   ""
)
(command "_.explode" (entlast))
(command "_.zoom" "e")
(setq SS (ssget "p"))
(setq BLK_BOUND (ACET-GEOM-SS-EXTENTS SS t))
(setq MPT (mapcar '/
   (mapcar '+ (car BLK_BOUND) (cadr BLK_BOUND))
   '(2.0 2.0 2.0)
   )
)
(command "_.WBLOCK"
   (strcat PATH "\\" "1-" NAME)
   ""
   "non"
   MPT
   SS
   ""
)
(command "_.purge" "b" "*" "n")
)
(setvar "cmdecho" CMDECHO-SAVE)
(princ)
)

congcong96 发表于 2008-11-11 11:28:00

谢谢啊！我的问题解决了，o(∩_∩)o... 差距实在太大了

页: [1]

明经CAD社区's Archiver

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