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

调用 (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:45:11

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

我试(vlax-invokeblk 'Explode)成功了

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

自贡黄明儒 发表于 2013-8-5 08:45 static/image/common/back.gif
我试(vlax-invokeblk 'Explode)成功了

两个都成功的吗?我试的是一个能成功,一个提示输入命令无效
我用的是CAD2006版本
页: [1]
查看完整版本: 调用 (vlax-invoke BLK 'EXPLODE) 命令无效的问题