Topic: Break on line by Jurg Menzi **Mod Lisp ** request

[cadmoogle]

Could anyone modify this lisp to break along a polyline, not just a line and have it break at the insertion point of the block and not the ends of the block? Also, which is not a big deal; turn on selection so you know what items are highlighted. Thank you   

I've also posted on cadalyst so for those who visit both can be aware 

Code: [Select]

;
; -- 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)...[list]
;   > 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)
 )
)
;
; -- 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)...[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 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
)
;;------------------------------------------------------------------------------------------------------
(defun break-line-at-block (blk / ll ur line-sel line-ob line-fp line-lp line-inter *ThisDrawing* *Space* firstpt)
  (if blk
    (progn
      (vla-getboundingbox blk 'll 'ur)
      (setq ll (trans (vlax-safearray->list ll) 0 1))
      (setq ur (trans (vlax-safearray->list ur) 0 1))
      (if (and (setq line-sel (ssget "_CP" (list ll (list (car ll)(cadr ur)(caddr ll)) ur (list (car ur)(cadr ll)(caddr ur))) '((0 . "line"))))
    (setq line-ob (vlax-ename->vla-object (ssname line-sel 0)))
    (setq line-fp (vlax-safearray->list (vlax-variant-value (vla-get-startpoint line-ob))))
    (setq line-lp (vlax-safearray->list (vlax-variant-value (vla-get-endpoint line-ob))))
    (setq line-inter (vl-sort (VxGetBlockInters blk line-ob acExtendBoth)(function (lambda(a1 a2)(< (distance a1 line-fp)(distance a2 line-fp))))))
  )
(progn
  (setq *ThisDrawing* (vla-get-ActiveDocument (vlax-get-acad-object)))
  (setq *Space* (vlax-get-property *ThisDrawing* (nth (vla-get-ActiveSpace *ThisDrawing*)'("PaperSpace" "ModelSpace"))))
          (setq firstpt (car line-inter))
          (setq lastpt (last line-inter))
  (if (and (setq f-line (vla-addline *Space* (vlax-3d-point line-fp)
     (vlax-3d-point (if (< (distance lastpt line-fp)(distance firstpt line-fp)) lastpt firstpt))))
           (setq s-line (vla-addline *Space* (vlax-3d-point (if (< (distance firstpt line-lp)(distance lastpt line-lp)) firstpt lastpt)) (vlax-3d-point line-lp))))
    (progn
      (vla-put-layer f-line (vla-get-layer line-ob))
      (vla-put-layer s-line (vla-get-layer line-ob))
      (vla-put-linetype f-line (vla-get-linetype line-ob))
      (vla-put-linetype s-line (vla-get-linetype line-ob))
      (vla-delete line-ob)
    )
  )
)
      )
    ) ; progn
  ) ; if
  (princ)
) ;_ break-line-at-block

;;------------------------------------------------------------------------------------------------------
(defun c:br-li (/ blks)
  (vl-load-com)
  (if (setq blks (ssget (LIST (cons 0 "INSERT"))))
    (mapcar (function (lambda(x)
(if (= (type x) 'ENAME)(break-line-at-block (vlax-ename->vla-object x))))) (mapcar 'cadr (ssnamex blks)))
  )
  (princ)
)
;;(c:br-li)


[CAB]

Cadmoogle,
Welcome back & thanks for posting.
There is an issue with posting copyrighted material without the authors permission.
If you have permission then no harm done. Although without permission then a link to where the
material can be downloaded from the author is a preferred method. It may be that Jurg has posted these
subroutines here already as he has contributed a lot of code here in the past. If Jurg already post the code
here at the Swamp or another public forum please disregard my post.

Here is more information on copyrights.
http://www.theswamp.org/index.php?topic=14304.0

[cadmoogle]

All but one of the subroutines can be found on his website:
http://www.menziengineering.ch/Downloads/Download.htm

This code was posted on the Autodesk forums
http://discussion.autodesk.com/forums/thread.jspa?messageID=5729609&#5729609

I've contacted Jurg through his site, but have yet to hear anything back. It could be because of the time difference. Let me know if I need to provide more information or remove the lisp.

Thanks CAB,
Daniel

[cadmoogle]

Problem solved (I hope). I've received a couple of replies back one being Jurg, so hopefully it will work out. I will test it out the codes tomorrow and if I have any further questions I'll reply.

Thanks,
Daniel

[CAB]

Thanks Daniel.

Would you post a link to the revised code so all here could benefit?

[cadmoogle]

Wizman provided some code here
http://forums.cadalyst.com/showthread.php?p=22855#post22855

Jurg's revised copy (that he did) is below.

I hope this helps. Thanks for the help,
Daniel

Code: [Select]

;
; -- 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)... [LIST]
;   > 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)
 )
)
;
; -- 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)... [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 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
)
;;------------------------------------------------------------------------------------------------------
(defun break-line-at-block (blk / ll ur line-sel line-ob line-fp line-lp line-inter *ThisDrawing* *Space* firstpt)
  (if blk
    (progn
      (vla-getboundingbox blk 'll 'ur)
      (setq ll (trans (vlax-safearray->list ll) 0 1))
      (setq ur (trans (vlax-safearray->list ur) 0 1))
      (if (and
           (setq line-sel (ssget "_C" (list (car ll) (cadr ll)) (list (car ur) (cadr ur)) '((0 . "LINE,POLYLINE,LWPOLYLINE"))))
   (setq line-ob (vlax-ename->vla-object (ssname line-sel 0)))
   (setq line-fp (vlax-curve-getStartPoint line-ob))
   (setq line-lp (vlax-curve-getEndPoint line-ob))
   (setq line-inter (vl-sort
                             (VxGetBlockInters blk line-ob acExtendBoth)
                             (function (lambda (a1 a2) (< (distance a1 line-fp) (distance a2 line-fp))))
                            )
           )
  )
(progn
  (setq *ThisDrawing* (vla-get-ActiveDocument (vlax-get-acad-object)))
  (setq *Space* (vlax-get-property *ThisDrawing* (nth (vla-get-ActiveSpace *ThisDrawing*)'("PaperSpace" "ModelSpace"))))
          (setq firstpt (car line-inter))
          (setq lastpt (last line-inter))
  (if (and
               (setq f-line (vla-addline
                             *Space*
                             (vlax-3d-point line-fp)
             (vlax-3d-point
                              (if (< (distance lastpt line-fp) (distance firstpt line-fp))
                               lastpt
                               firstpt
                              )
                             )
                            )
               )
       (setq s-line (vla-addline
                             *Space*
                             (vlax-3d-point
                              (if (< (distance firstpt line-lp) (distance lastpt line-lp))
                               firstpt
                               lastpt
                              )
                             )
                             (vlax-3d-point line-lp)
                            )
               )
              )
    (progn
      (vla-put-layer f-line (vla-get-layer line-ob))
      (vla-put-layer s-line (vla-get-layer line-ob))
      (vla-put-linetype f-line (vla-get-linetype line-ob))
      (vla-put-linetype s-line (vla-get-linetype line-ob))
      (vla-delete line-ob)
    )
  )
)
      )
    ) ; progn
  ) ; if
  (princ)
) ;_ break-line-at-block

;;------------------------------------------------------------------------------------------------------
(defun c:br-li (/ blks)
  (vl-load-com)
  (if (setq blks (ssget (LIST (cons 0 "INSERT"))))
    (mapcar (function (lambda(x)
(if (= (type x) 'ENAME)(break-line-at-block (vlax-ename->vla-object x))))) (mapcar 'cadr (ssnamex blks)))
  )
  (princ)
)
;;(c:br-li)


[CAB]

Nice routine.
I did change one line to get it to work properly with my complex block test.

Code: [Select]

(VxGetBlockInters blk line-ob acExtendNone) ;acExtendBoth) ; CAB changed