Enclose object inside rectangular envelope, draw vertical and horizontal lines from midpoint to midpoint then insert block at the center

[Julius_Ceazar]

Hi,

I'm looking for a lisp routine to enclose an object on a rectangle then draw vertical and horizontal lines that will serve as centerlines for the rectangle and finally insert a block on the center of the rectangle.

I've attached a sample image for reference.

The yellow box is the envelope, the magenta lines are the centerlines and the circle on the center is the inserted block.

The hatched polygon is the sample object.

Thank you in advance.

[Anonymous]

Its not a hard task provided outside rectang is a pline. You can get the Vertice pts so you can then work out all the other points. Rather than post full solution this is the snippets needed. The only way to learn is have a go.

(setq plent (entsel "\nPick rectang"))
(if plent (setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car plent))))))

(setq pt1 (nth 0 co-ord) pt2 (nth 1 co-ord) pt3 (nth 2 co-ord) pt4 (nth 3 co-ord))

(setq mpt1 (mapcar '* (mapcar '+ pt1 pt2) '(0.5 0.5)))

Then just draw plines etc using mpt1 mpt2..... 

Same for Circle work out a midpt 

Write down all the steps as you do it manually and just convert them to lisp steps.

[pbejse]

---

@Julius_Ceazar wrote:

I'm looking for a lisp routine to enclose an object

---

One object and NOT multiple objects? 

(defun c:demo ( / LWPoly _midOf obj  data pts)
(defun LWPoly (lst cls)
  (entmakex
    (append (list (cons 0 "LWPOLYLINE")
		  (cons 100 "AcDbEntity")
		  (cons 100 "AcDbPolyline")
		  (cons 90 (length lst))
		  (cons 70 cls)
	    )
	    (mapcar (function (lambda (p) (cons 10 p))) lst)
    )
  )
)
(defun _midOf (p1 p2)
       (mapcar '(lambda (a b) (/ (+ a b) 2.)) p1 p2)
  )

  
  (if (setq obj (car (entsel "\nSelect object to enclose")))
    (progn
      (vla-getboundingbox (vlax-ename->vla-object obj) 'll 'ur)
      (setq data (mapcar 'vlax-safearray->list (list ll ur)))
      (setq pts (list (Car data)
			 (list (Caadr data)(cadar data) 0.0)
			 (Cadr data)
			 (list (caar data) (cadadr data) 0.0)
			 )
	    )
      (LWPoly pts 1)
      (LWPoly (list (_midOf (car pts)(cadr pts))
		    (_midOf (cadddr pts)(caddr pts))) 0)
      (LWPoly (list (_midOf (car pts)(cadddr pts))
		    (_midOf (cadr pts)(caddr pts))) 0)
      (vlax-invoke (vlax-get
                           (vla-get-ActiveLayout
                                               (vla-get-activedocument
                                                     (vlax-get-acad-object)))
                                         'Block)
                                   'InsertBlock
                                   (_midOf (car pts)(caddr pts))
                                   "YourBlockname"
                                   1 1 1 0)
      )
    )
  (princ)
  )

HTH

[Kent1Cooper]

(vl-load-com); if needed
(defun C:WHATEVER (/ minpt maxpt LL UR midpt)
  (vla-getboundingbox
  (vlax-ename->vla-object (car (entsel "\nSelect object: ")))
    'minpt 'maxpt
  ); ...ename->obj...
  (setq
    LL (vlax-safearray->list minpt)
    UR (vlax-safearray->list maxpt)
    midpt (mapcar '/ (mapcar '+ LL UR) '(2 2 2))
  ); setq
  (command
    "_.layer" "_set" "YourOuterRectangleLayer" ""
    "_.rectang" "_non" LL "_none" UR
    "_.layer" "_set" "YourCrosshairsLayer" ""
    "_.line" "_non" (list (car LL) (cadr midpt)) "_non" (list (car UR) (cadr midpt)) ""
    "_.line" "_non" (list (car midpt) (cadr LL)) "_non" (list (car midpt) (cadr UR)) ""
    "_.layer" "_set" "YourBlockLayer" ""
    "_.insert" "YourBlockName" "_non" midpt "" "" ""
  ); command
); defun

Edit all the bold teal italic things appropriately.

It assumes:

1)  the Layers and the Block definition exist in the drawing;

2)  the Block is one with a wipeout to hide the crossing of the crosshairs behind it, so it can draw just the two Lines.

3)  scale factors of 1 and rotation of 0 are appropriate for the Block Insertion.

But if those things can't be assumed, they can be accounted for with some additional code.

It takes selection of a single object, but can easily be adjusted to do the same around the collective extents of multiple objects [I have another routine with the code to do that].

It works [in minimal testing] whether or not the number in your image is an Attribute in the Block.  If it is, the routine leaves you at the point of giving it a value for the Attribute, before the Block appears.  If not, the placing of the number as Text can be added.

[Kent1Cooper]

---

@Kent1Cooper wrote:

....
  (vla-getboundingbox
  (vlax-ename->vla-object (car (entsel "\nSelect object: ")))
    'minpt 'maxpt
  ); ...ename->obj...

....

---

No difference in the operation, but to be more correctly commented on, that much should be:

....

  (vla-getboundingbox
    (vlax-ename->vla-object (car (entsel "\nSelect object: ")))
    'minpt 'maxpt
  ); ...boundingbox...

....

[Julius_Ceazar]

Thank you. I'm still on the process of learning lisp language.

Will definitely try your advice.

[Julius_Ceazar]

Thanks @pbejse . It worked.

Is there a huge difference if I want to select multiple objects and put them in one envelope?

[Julius_Ceazar]

Thank you so much @Kent1Cooper. It worked.

If I want to select multiple objects and enclose them on an envelope, is it also possible with this method too?

[pbejse · Accepted solution]

---

@Julius_Ceazar wrote:

Thanks @pbejse . It worked.

Is there a huge difference if I want to select multiple objects and put them in one envelope?

---

Not at all

(defun c:Enveloped ( / LWPoly _midOf obj data pts Xc Yc)
(defun LWPoly (lst lay cls)
  (entmakex
    (append (list (cons 0 "LWPOLYLINE")
		  (cons 100 "AcDbEntity")
		  (cons 100 "AcDbPolyline")
		  (cons 90 (length lst))
		  (cons 8 lay)
		  (cons 70 cls)
	    )
	    (mapcar (function (lambda (p) (cons 10 p))) lst)
    )
  )
)
(defun _midOf (p1 p2)
       (mapcar '(lambda (a b) (/ (+ a b) 2.)) p1 p2)
  )

(prompt "\nSelect objects to enclosed")
(if (and
      (tblsearch "BLOCK" "YourBlockname");<-- make sure to change this to your block name
      (setq ss (ssget))
      )
    (progn
      (repeat (setq i (sslength ss))
	(setq e (vlax-ename->vla-object (ssname ss (setq i (1- i)))))
	(and (vlax-method-applicable-p  e 'Getboundingbox)
      		 (not (vla-GetboundingBox e 'll 'ur))
		 (Setq Xc (cons (vlax-safearray->list ll) Xc))
		 (Setq Yc (cons (vlax-safearray->list ur) Yc))
	)
      )
      (setq data (list (apply 'mapcar (Cons 'min  Xc))
		       (apply 'mapcar (Cons 'max  Yc))))
      
      (setq pts (list (Car data)
			 (list (Caadr data)(cadar data) 0.0)
			 (Cadr data)
			 (list (caar data) (cadadr data) 0.0)
			 )
	    )
;;	makes sure to change  "RectangleLayer" and "LineLayer" 	;;
;; 		to your standard layer name      		;;
      (LWPoly pts "RectangleLayer" 1)	
      (LWPoly (list (_midOf (car pts)(cadr pts))
		    (_midOf (cadddr pts)(caddr pts))) "LineLayer" 0) 
      (LWPoly (list (_midOf (car pts)(cadddr pts))
		    (_midOf (cadr pts)(caddr pts))) "LineLayer" 0) 
      
      (vlax-invoke (vlax-get
                           (vla-get-ActiveLayout
                                               (vla-get-activedocument
                                                     (vlax-get-acad-object)))
                                         'Block)
                                   'InsertBlock
                                   (_midOf (car pts)(caddr pts))
                                   "YourBlockname"
                                   1 1 1 0)
      )
    )
  (princ)
  )

HTH

[Julius_Ceazar]

Thank you @pbejse. Worked perfectly with multiple objects.

[pbejse]

---

@Julius_Ceazar wrote:

Thank you @pbejse. Worked perfectly with multiple objects.

---

Good for you, glad it helps.

And you are welcome.

[Kent1Cooper · Accepted solution]

---

@Julius_Ceazar wrote:

Thank you so much @Kent1Cooper. It worked.

If I want to select multiple objects and enclose them on an envelope, is it also possible with this method too?

---

Yes:

(vl-load-com); if needed
(defun C:WHATEVER (/ ss n minpt maxpt eLL eUR LL UR midpt)
  (prompt "\nTo Draw the Box around Multiple objects with Crosshairs & Block,")
  (if (setq ss (ssget))
    (progn ; then
      (repeat (setq n (sslength ss))
        (vla-getboundingbox (vlax-ename->vla-object (ssname ss (setq n (1- n)))) 'minpt 'maxpt)
        (setq
          eLL (vlax-safearray->list minpt)
          eUR (vlax-safearray->list maxpt)
          LL (if LL (mapcar 'min eLL LL) eLL)
          UR (if UR (mapcar 'max eUR UR) eUR)
        ); setq
      ); repeat
      (setq midpt (mapcar '/ (mapcar '+ LL UR) '(2 2 2)))
      (command
        "_.layer" "_set" "YourOuterRectangleLayer" ""
        "_.rectang" "_non" LL "_none" UR
        "_.layer" "_set" "YourCrosshairsLayer" ""
        "_.line" "_non" (list (car LL) (cadr midpt)) "_non" (list (car UR) (cadr midpt)) ""
        "_.line" "_non" (list (car midpt) (cadr LL)) "_non" (list (car midpt) (cadr UR)) ""
        "_.layer" "_set" "YourBlockLayer" ""
        "_.insert" "YourBlockName" "_non" midpt "" "" ""
      ); command
    ); progn
  ); if
  (princ)
); defun

Edit the Layer and Block names as before.

[pbejse]

---

@Kent1Cooper wrote:

---

...
      (repeat (setq n (sslength ss))
        (vla-getboundingbox (vlax-ename->vla-object (ssname ss (setq n (1- n)))) 'minpt 'maxpt)
        (setq
          eLL (vlax-safearray->list minpt)
          eUR (vlax-safearray->list maxpt)
          LL (if LL (mapcar 'min eLL LL) eLL)
          UR (if UR (mapcar 'max eUR UR) eUR)
        ); setq
      ); repeat
     ...

---

Thats brilliant 👍 .

[Julius_Ceazar]

Thank you @Kent1Cooper . This solution also works.

Only proves that it's possible to have multiple solution to a single problem.