Change line color of entire block if overlapping with other block

Change line color of entire block if overlapping with other block

Anonymous
Not applicable
1,140 Views
2 Replies
Message 1 of 3

Change line color of entire block if overlapping with other block

Anonymous
Not applicable

Hello,

 

I love this forum and use it daily as a starting point for problem solving. I have a unique problem I couldn't really find a solution to. So here it goes! 

 

I have a custom tool palette with a number of unique blocks (electrical boxes).

 

The user imports the blocks into their own less complex drawing to determine if everything will fit, or not. 

 

I would like to give the user a warning of some kind if the blocks they have imported overlap with another block they imported (only blocks from the tool palette matter). 

 

I was thinking of a color change (red) of the recently dropped in block to show it does not fit, but any sort of warning will do.

 

Any help is appreciated! 

0 Likes
1,141 Views
2 Replies
Replies (2)
Message 2 of 3

pbejse
Mentor
Mentor

Preview


@Anonymous wrote:

Hello,

...

I would like to give the user a warning of some kind if the blocks they have imported overlap with another block they imported (only blocks from the tool palette matter). 

 

I was thinking of a color change (red) of the recently dropped in block to show it does not fit, but any sort of warning will do.

 


To ensure the geometry of the block will be the same, ( If the block has the same name) use right click menu from the Tool Palette to redefine any block to the preffered or latest instance of the block.

 

0 Likes
Message 3 of 3

Anonymous
Not applicable

Thank you for the response. I am looking for something automated. 

 

After digging around on this, I've found a Lee Mac code snippet that does essentially what I want, flag intersection points of specified blocks. 

 

I am going to try and adapt this code to fit my data - more specifically, add a list of tool palette blocks as the input, instead of user-selected, and add my own block "flag" as the intersection geometry, instead of user-selected. 

 

 

;;------------=={ Insert Block at Intersections }==-----------;;
;;                                                            ;;
;;  Prompts the user to select or specify a block to be       ;;
;;  inserted, and make a selection of intersecting objects.   ;;
;;  Proceeds to insert the specified block at all points of   ;;
;;  intersection between all objects in the selection.        ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2012 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;

(defun c:ib ( / *error* a b bfn blk cmd i j sel spc )

    (defun *error* ( msg )
        (LM:endundo (LM:acdoc))
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\nError: " msg))
        )
        (princ)
    )
    
    (while
        (progn
            (setvar 'errno 0)
            (initget "Name Browse Exit")
            (setq sel (entsel "\nSelect block to insert [Name/Browse] : "))
            (cond
                (   (= 7 (getvar 'errno))
                    (princ "\nMissed, try again.")
                )
                (   (or (null sel) (= "Exit" sel))
                    nil
                )
                (   (= "Browse" sel)
                    (if (setq bfn (getfiled "Select Block" (getvar 'dwgprefix) "dwg" 16))
                        (if (null (tblsearch "block" (setq blk (cadr (fnsplitl bfn)))))
                            (progn
                                (setq cmd (getvar 'cmdecho))
                                (setvar 'cmdecho 0)
                                (command "_.-insert" bfn nil)
                                (setvar 'cmdecho cmd)
                                (null (tblsearch "block" blk))
                            )
                        )
                        (princ "\n*Cancel*")
                    )
                )
                (   (= "Name" sel)
                    (while
                        (not
                            (or (= "" (setq blk (getstring t "\nSpecify block name: ")))
                                (tblsearch "block" blk)
                            )
                        )
                        (princ "\nBlock not found.")
                    )
                    (= "" blk)
                )
                (   (= 'list (type sel))
                    (if (= "INSERT" (cdr (assoc 0 (entget (car sel)))))
                        (setq blk (LM:blockname (vlax-ename->vla-object (car sel))))
                        (princ "\nObject is not a block.")
                    )
                )
            )
        )
    )

    (if
        (and
            (= 'str (type blk))
            (tblsearch "block" blk)
            (setq sel (ssget))
        )
        (progn
            (setq spc
                (vlax-get-property (LM:acdoc)
                    (if (= 1 (getvar 'cvport))
                        'paperspace
                        'modelspace
                    )
                )
            )
            (LM:startundo (LM:acdoc))
            (repeat (setq i (sslength sel))
                (setq a (vlax-ename->vla-object (ssname sel (setq i (1- i)))))
                (if (vlax-method-applicable-p a 'intersectwith)
                    (repeat (setq j i)
                        (setq b (vlax-ename->vla-object (ssname sel (setq j (1- j)))))
                        (if (vlax-method-applicable-p b 'intersectwith)
                            (foreach p (LM:intersections a b acextendnone)
                                (vla-insertblock spc (vlax-3D-point p) blk 1.0 1.0 1.0 0.0)
                            )
                        )
                    )
                )
            )
            (LM:endundo (LM:acdoc))
        )
    )
    (princ)
)

;; Intersections  -  Lee Mac
;; Returns a list of all points of intersection between two objects
;; obj1,obj2 - VLA-Objects with the intersectwith method applicable
;; mode      - acextendoption enum of intersectwith method

(defun LM:intersections ( obj1 obj2 mode / l r )
    (setq l (vlax-invoke obj1 'intersectwith obj2 mode))
    (repeat (/ (length l) 3)
        (setq r (cons (list (car l) (cadr l) (caddr l)) r)
              l (cdddr l)
        )
    )
    (reverse r)
)

;; Block Name  -  Lee Mac
;; Returns the true (effective) name of a supplied block reference
                        
(defun LM:blockname ( obj )
    (if (vlax-property-available-p obj 'effectivename)
        (defun LM:blockname ( obj ) (vla-get-effectivename obj))
        (defun LM:blockname ( obj ) (vla-get-name obj))
    )
    (LM:blockname obj)
)

;; Start Undo  -  Lee Mac
;; Opens an Undo Group.

(defun LM:startundo ( doc )
    (LM:endundo doc)
    (vla-startundomark doc)
)

;; End Undo  -  Lee Mac
;; Closes an Undo Group.

(defun LM:endundo ( doc )
    (while (= 8 (logand 8 (getvar 'undoctl)))
        (vla-endundomark doc)
    )
)

;; Active Document  -  Lee Mac
;; Returns the VLA Active Document Object

(defun LM:acdoc nil
    (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
    (LM:acdoc)
)

(vl-load-com) (princ)​

 

0 Likes