Line with block break - need loop

[Anonymous]

Hi guys,

The function below make two break 2 points in line (for each interference with line-block)

Auxiliar functions - credits to Juerg Menzi (thank you)

http://www.menziengineering.ch

The routine works ok with 1 line, but I need 2 loops, for each line containing blocks.

To make a test, draw a circle, convert it to block, insert some copies in line, and execute MIB.

See... Break all interferences line-block.

I need to add loop to works with multiple lines containing blocks (along it)



Thanks in advance,

:)


Rogerio

The code (start command: MIB)

(defun c:mib (/ VxGetInters VxGetBlockInters w1 w2 ss_lin 1ent lst lin ss_blk 2ent int_lst p1 p2 )
;-----------------------Auxiliar functions - begin
;VxGetBlockInters and VxGetBlockInters functions
;Credits to
;Juerg Menzi
;MENZI ENGINEERING GmbH, Switzerland
;http://www.menziengineering.ch

;Returns all intersection points between a block and an object

; -- Function VxGetBlockInters
; Returns all intersection points between a Block and an object.
; Copyright:
; ©2001-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)...

; > 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 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")
)
)
((eq ObjNme "AcDbBlockReference")
(if (setq TmpVal (VxGetBlockInters memb Obj Mde))
(setq PntLst (append PntLst TmpVal))
)
)
(T
(if (setq TmpVal (VxGetInters memb Obj Mde))
(setq PntLst (append PntLst TmpVal))
)
)
)
(vla-Delete memb)
)
PntLst
)

;-------------------------------------------------
;Returns all intersection points between two objects

;
; -- Function VxGetInters
; Returns all intersection points between two objects.
; Copyright:
; ©2000 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)...

; > Nil if no intersection found
; Notes:
; - None
;
(defun VxGetInters (Fst Nxt Mde / IntLst PntLst)
(setq IntLst (vlax-invoke Fst 'IntersectWith Nxt Mde))
(cond
(IntLst
(repeat (/ (length IntLst) 3)
(setq PntLst (cons
(list
(car IntLst)
(cadr IntLst)
(caddr IntLst)
)
PntLst
)
IntLst (cdddr IntLst)
)
)
(reverse PntLst)
)
(T nil)
)
)
;-----------------------Auxiliar functions - End
;-----------------------Main function
(vl-load-com)
(setq n 0)
(setq q 0)
(setq ss_lin (ssget (list (cons 0 "*LINE"))))
(if ss_lin
(setq lin_len (sslength ss_lin))
)
(setq 1ent (cdr (assoc -1 (entget (ssname ss_lin n)))))
(setq lin (vlax-ename->vla-object 1ent))
(setq ptlst (acet-geom-object-point-list 1ent 10));;need Express Tools instaled
(setq ss_blk (ssget "f" ptlst (list (cons 0 "INSERT"))))
(if ss_blk
(setq blk_len (sslength ss_blk))
)
(repeat blk_len
(setq ss_blk (ssget "f" ptlst (list (cons 0 "INSERT"))))
(setq 2ent (cdr (assoc -1 (entget (ssname ss_blk q)))))
(setq blk (vlax-ename->vla-object 2ent))
(setq int_lst (vxgetblockinters blk lin 3))
(setq p1 (car int_lst))
(setq p2 (car (cdr int_lst)))
(command "draworder" ss_lin "" "f")
(command "break" p1 p2)
(setq n (1+ n))
(setq q (1+ q))
)
(princ)
)