调用 (vlax-invoke BLK 'EXPLODE) 命令无效的问题
文件如附件所示,代码如下(主要目的是打断与块相交的端线),同一个图块,其中一些能调用该命令,而有些却不能(提示: ; 错误: AutoCAD.Application: 输入无效),为什么会这样,百思不得其解啊?要怎样才能正确处理呢?请哪位高人指点一下,谢谢!;;VxGetInters - Returns all intersection points between two objects
;;
;; -- Function VxGetInters
;; Returns all intersection points between two objects.
;; Copyright:
;; ?000 MENZI ENGINEERING GmbH, Switzerland
;; Arguments :
;; Fst = First object
;; Nxt = Second object
;; Mde = Intersection mode
;; Constants:
;; - acExtendNone Does not extend either object.
;; - acExtendThisEntity Extends the Fst object.
;; - acExtendOtherEntity Extends the Nxt object.
;; - acExtendBoth Extends both objects.
;; Return :
;; > List of points '((1.0 1.0 0.0)...
;; > Nil if no intersection found
;; Notes:
;; - None
;;
(defun VXGETINTERS (FST NXT MDE / INTLST PNTLST TYP)
(setq TYP (cdr (assoc 0 (entget (vlax-vla-object->ename FST)))) )
(if (or(= TYP"LINE") (= TYP "LWPOLYLINE")(= TYP"CIRCLE") (= TYP"ARC") )
(setq INTLST (vlax-invoke FST 'INTERSECTWITH NXT MDE))
)
(cond(INTLST ;;;如果INTLST存在,则进入交点处理程序
(repeat (/ (length INTLST) 3) ;;;每次处理一组交点
(setq PNTLST (cons(list(car INTLST)(cadr INTLST)(caddr INTLST) )PNTLST ) ;;;提取前三个数据放入PNTLST中
INTLST (cdddr INTLST) ;;;cdddr相当于删除前三个数据
)
)
(reverse PNTLST)
)
(t NIL)
)
)
;;VxGetBlockInters - Returns all intersection points between a block and an obj...
;;
;; -- Function VxGetBlockInters
;; Returns all intersection points between a Block and an object.
;; Copyright:
;; ?001-2002 MENZI ENGINEERING GmbH, Switzerland
;; Arguments :
;; Blk = Block object
;; Obj = Object
;; Mde = Intersection mode
;; Constants:
;; - acExtendNone Does not extend either object.
;; - acExtendThisEntity Extends the Fst object.
;; - acExtendOtherEntity Extends the Nxt object.
;; - acExtendBoth Extends both objects.
;; Return :
;; > list of points '((1.0 1.0 0.0)...
;; > Nil if no intersection found
;; Notes:
;; - Because of a (reported) bug in A2k4/A2k5/A2k6, the used explode method
;; will fail on NUS blocks. No limitations in A2k, A2ki and A2k2
(defun C:BF( / i os line_obj block_obj selection lw line_point)
(setvar "cmdecho" 0)
(setq os (getvar "osmode"))
(vl-load-com)
(prompt "选择断开块及被断开直线:")
(setq selection (ssget))
( repeat(setq i (sslength selection))
(setq i (1- i))
(if
(OR (= (cdr (assoc 0 (entget (ssname selection i )) )) "LINE")
(= (cdr (assoc 0 (entget (ssname selection i )) )) "LWPOLYLINE")
)
(setq line_obj (entget (ssname selection i )))
) ;;;找出line_object
(if
(= (cdr (assoc 0 (entget (ssname selection i )) )) "INSERT")
(setq block_obj (entget (ssname selection i )))
) ;;;找出insert_object
)
(cond ( (= line_objNil)(prompt "\n没有选中直线") )
( (= block_obj Nil)(prompt "\n没有选中打断块"))
)
(if (and (/= line_obj Nil)(/= block_obj Nil) )
(progn
(setq inter_point (VXGETBLOCKINTERS(vlax-ename->vla-object (cdar block_obj))
(vlax-ename->vla-object (cdar line_obj ))acextendnone )
)
(if (= inter_point Nil)
(prompt "\n 所选直线与块之间无交点")
(BREAK_INTER inter_point)
)
)
)
(princ)
)
|;
;**************************************************************************************************************************************************
(defun VXGETBLOCKINTERS(BLK OBJ MDE / OBJNME PNTLST TMPVAL)
(foreach MEMB(vlax-invoke BLK 'EXPLODE)
(setq OBJNME (vla-get-objectname MEMB))
(cond
((or
(not (vlax-method-applicable-p MEMB 'INTERSECTWITH))
(and
(eq OBJNME "AcDbHatch")
(eq (strcase (vla-get-patternname MEMB)) "SOLID")
)
(eq OBJNME "AcDb3dSolid")
)
) ;;;第一层cond判断 是否能和需要求交点
((eq OBJNME "AcDbBlockReference") ;;;这里处理块中块,循环调用
(if(setq TMPVAL (VXGETBLOCKINTERS MEMB OBJ MDE))
(setq PNTLST (append PNTLST TMPVAL))
)
) ;;;第二层cond判断是否是块中块
(t
(if(setq TMPVAL (VXGETINTERS MEMB OBJ MDE)) ;;调用求交点子程序
(setq PNTLST (append PNTLST TMPVAL))
)
) ;;;第三层cond判段求出交点并将交点放入表PNTLST中
)
(vla-delete MEMB)
)
PNTLST
)
;;*******************************************************************************************************************************************
(defun BREAK_INTER( inter_point / angle_ angle_tag i end_point start_point line_select)
(setq angle_ (angle (nth 0 inter_point) (nth (1- (length inter_point )) inter_point)))
(if (or (and (<=angle_ 0.15) (>=angle_0 ))
(and (<=angle_ 3.3 ) (>=angle_ 3.0))
(>=angle_6.1 )
)
(setq angle_tag 1)
)
(if (= angle_tag 1)
(progn
(setqstart_point(nth 0 inter_point)end_point(nth 0 inter_point))
(repeat(setq i (1- (length inter_point)))
(if (>(car (nth i inter_point)) (car end_point) )(setq end_point (nth i inter_point)))
(if (<(car (nth i inter_point)) (car start_point))(setq start_point (nth i inter_point)))
(setq i (1- i))
)
)
(progn
(setqstart_point(nth 0 inter_point)end_point (nth 0 inter_point) )
(repeat(setq i (setq i (1- (length inter_point))))
(if (>(cadr (nth i inter_point)) (cadr end_point) )(setq end_point (nth i inter_point)))
(if (<(cadr (nth i inter_point)) (cadr start_point))(setq start_point (nth i inter_point)))
(setq i (1- i))
)
)
)
(setvar "osmode" 0)
(setq line_select (polar start_point (angle start_point end_point) -2))
( command "break" line_select "f" start_point end_point)
(setvar "osmode" os)
(princ)
)
本帖最后由 自贡黄明儒 于 2013-8-5 08:51 编辑
我试(vlax-invokeblk 'Explode)成功了
自贡黄明儒 发表于 2013-8-5 08:45 static/image/common/back.gif
我试(vlax-invokeblk 'Explode)成功了
两个都成功的吗?我试的是一个能成功,一个提示输入命令无效
我用的是CAD2006版本
页:
[1]