调用 (vlax-invoke BLK 'EXPLODE) 命令无效的问题

zjupxw · 发表于 2013-8-4 22:13

文件如附件所示，代码如下（主要目的是打断与块相交的端线），同一个图块，其中一些能调用该命令，而有些却不能（提示： ; 错误: 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 [Type]:
;; Fst = First object [VLA-OBJECT]
;; Nxt = Second object [VLA-OBJECT]
;; Mde = Intersection mode [INT]
;; Constants:
;; - acExtendNone Does not extend either object.
;; - acExtendThisEntity Extends the Fst object.
;; - acExtendOtherEntity Extends the Nxt object.
;; - acExtendBoth Extends both objects.
;; Return [Type]:
;; > List of points '((1.0 1.0 0.0)... [LIST]
;; > 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 [Type]:
;; Blk = Block object [VLA-OBJECT]
;; Obj = Object [VLA-OBJECT]
;; Mde = Intersection mode [INT]
;; Constants:
;; - acExtendNone Does not extend either object.
;; - acExtendThisEntity Extends the Fst object.
;; - acExtendOtherEntity Extends the Nxt object.
;; - acExtendBoth Extends both objects.
;; Return [Type]:
;; > list of points '((1.0 1.0 0.0)... [LIST]
;; > 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_obj Nil) (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
(setq start_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
(setq start_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)
)

;;VxGetInters - Returns all intersection points between two objects 
;; 
;; -- Function VxGetInters 
;; Returns all intersection points between two objects. 
;; Copyright: 
;;   ?000 MENZI ENGINEERING GmbH, Switzerland 
;; Arguments [Type]: 
;;   Fst = First object [VLA-OBJECT] 
;;   Nxt = Second object [VLA-OBJECT] 
;;   Mde = Intersection mode [INT] 
;;         Constants: 
;;         - acExtendNone           Does not extend either object. 
;;         - acExtendThisEntity     Extends the Fst object. 
;;         - acExtendOtherEntity    Extends the Nxt object. 
;;         - acExtendBoth           Extends both objects. 
;; Return [Type]: 
;;   > List of points '((1.0 1.0 0.0)... [LIST] 
;;   > 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 [Type]: 
;;   Blk = Block object [VLA-OBJECT] 
;;   Obj = Object [VLA-OBJECT] 
;;   Mde = Intersection mode [INT] 
;;         Constants: 
;;         - acExtendNone           Does not extend either object. 
;;         - acExtendThisEntity     Extends the Fst object. 
;;         - acExtendOtherEntity    Extends the Nxt object. 
;;         - acExtendBoth           Extends both objects. 
;; Return [Type]: 
;;   > list of points '((1.0 1.0 0.0)... [LIST] 
;;   > 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_obj  Nil)  (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 
        (setq  start_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 
        (setq  start_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:45

本帖最后由自贡黄明儒于 2013-8-5 08:51 编辑

我试(vlax-invoke blk 'Explode)成功了

zjupxw · 发表于 2013-8-5 09:29

自贡黄明儒发表于 2013-8-5 08:45
我试(vlax-invoke blk 'Explode)成功了

两个都成功的吗？我试的是一个能成功，一个提示输入命令无效
我用的是CAD2006版本

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

[讨论] 调用 (vlax-invoke BLK 'EXPLODE) 命令无效的问题

本帖子中包含更多资源

点评

浏览过的版块