Visual LISP, AutoLISP and General Customization
cancel
Showing results for 
Show  only  | Search instead for 
Did you mean: 

Vla-getboundingbox and ucs issue

13 REPLIES 13
SOLVED
Reply
Message 1 of 14
Redraiderr2009
3031 Views, 13 Replies

Vla-getboundingbox and ucs issue

I have included a drawing that shows what the issue is. 

 

The first rectangle is drawn from 0,0 at the World Coordinate System. There is never any trouble with the code below when the objects are drawn at the WCS. 

 

The problem is when I try to draw a bounding box around an object while in another UCS. It seems that it always draws the bounding box at the WCS instead of my UCS. I have used (trans <pointlist> 0 1) on all combinations it seems and I still cannot get it to draw the bounding box at the current UCS. 

 

I was hoping someone has run into this before. 

Thanks,

 

(defun c:GetFromBoundingBox (
/

*ACAD_DOCUMENT*

mspace 
pSelectedObject
lwLeft
upLeft
lwRight
upRight
)

  (vl-load-com)
  (setq *ACAD_DOCUMENT* (vla-get-activedocument (vlax-get-acad-object)))
  (setq mspace (vla-get-ModelSpace *ACAD_DOCUMENT*))
  (setq pSelectedObject (vlax-ename->vla-object (car (entsel))))
  (vla-GetBoundingBox pSelectedObject 'minpoint 'maxpoint)

;; get the points of the bounding box ;;

;;; *** This did not work *** ;;
;;; (setq lwLeft (trans (vlax-safearray->list minpoint) 0 1)) ;;
;;; (setq upRight (trans (vlax-safearray->list maxpoint) 0 1)) ;;
;;; ************************* ;;
  (setq lwLeft (vlax-safearray->list minpoint))
  (setq upRight (vlax-safearray->list maxpoint))

  ;; make sure there are z coordinates. ;;
  (setq lwLeft (list (nth 0 lwLeft)(nth 1 lwLeft) 0))
  (setq upRight (list (nth 0 upRight)(nth 1 upRight) 0))

  ;; get the other two corners. ;;
  (setq upLeft (list (nth 0 lwLeft)(nth 1 upRight)0))
  (setq lwRight (list (nth 0 upRight)(nth 1 lwLeft)0))

  ;;; ;; Return list ;;
  (setq BboxPointsList (list lwLeft upLeft upRight lwRight))
  (vla-addline mspace (vlax-3d-point (nth 0 BboxPointsList)) (vlax-3d-point (nth 1 BboxPointsList)))
  (vla-addline mspace (vlax-3d-point (nth 1 BboxPointsList)) (vlax-3d-point (nth 2 BboxPointsList)))
  (vla-addline mspace (vlax-3d-point (nth 2 BboxPointsList)) (vlax-3d-point (nth 3 BboxPointsList)))
  (vla-addline mspace (vlax-3d-point (nth 3 BboxPointsList)) (vlax-3d-point (nth 0 BboxPointsList)))

  ;; Return Hieght ;;
  ;;; (distance lwLeft upLeft)

  (distance (trans lwLeft 1 0) (trans upLeft 1 0))
  ;;; (trans InsertPointAsList 1 0)

);_end defun ;;

13 REPLIES 13
Message 2 of 14
Lee_Mac
in reply to: Redraiderr2009

Try the following function by gile:

 

;; gc:UcsBoundingBox
;; Returns the UCS coordinates of the object bounding box about current UCS
;;
;; Arguments
;; obj: an entity (ENAME or VLA-OBJCET)
;; _OutputMinPtSym: a quoted symbol (output)
;; _OutputMaxPtSym: a quoted symbol (output)

(defun gc:UcsBoundingBox ( obj _OutputMinPtSym _OutputMaxPtSym )
    (and (= (type obj) 'ename)
         (setq obj (vlax-ename->vla-object obj))
    )
    (vla-transformby obj (vlax-tmatrix (gc:TMatrixFromTo 1 0)))
    (vla-getboundingbox obj _OutputMinPtSym _OutputMaxPtSym)
    (vla-transformby obj (vlax-tmatrix (gc:TMatrixFromTo 0 1)))
    (set _OutputMinPtSym (vlax-safearray->list (eval _OutputMinPtSym)))
    (set _OutputMaxPtSym (vlax-safearray->list (eval _OutputMaxPtSym)))
)

;; gc:TMatrixFromTo
;; Returns the 4X4 transformation matrix from a coordinate system to an other one
;;
;; Arguments
;; from to: same arguments as for the 'trans' function

(defun gc:TMatrixFromTo ( from to )
    (append
        (mapcar
            (function
                (lambda	( v o )
                    (append (trans v from to t) (list o))
                )
            )
           '(
                (1.0 0.0 0.0)
                (0.0 1.0 0.0)
                (0.0 0.0 1.0)
            )
            (trans '(0.0 0.0 0.0) to from)
        )
       '((0.0 0.0 0.0 1.0))
    )
)
(vl-load-com)

 

Message 3 of 14

That code did do something different than all the others I tried. While in the UCS it drew a box around the rectangle drawn at 0,0,0  in the WCS.

Message 4 of 14
Lee_Mac
in reply to: Redraiderr2009

Sorry, I didn't understand your response - did the function perform as required?

If not, how are you implementing the code?

Message 5 of 14

No,

I selected the box that is drawn at the current UCS (The white box), and it drew a an outline around the box drawn at the WCS. It now has a cyan line.

 

Basically I am trying to do this because I have a dynamic block that has an MTEXT ATTRIBUTE in it. The problem is that I have no way of knowing how many lines the MTEXT there are in the dynamic block. I was using the boundingbox to determine how tall the dynamic block should be. after it is inserted. (I have included an example)

 

Thanks,

 

Russell

Message 6 of 14
Lee_Mac
in reply to: Redraiderr2009

How are you implementing the code?

Note that the function returns points expressed relative to the current UCS as stated in the code header.

 

This quick test function works fine for me:

(defun c:test (/ ent llp urp )
    (if (setq ent (car (entsel)))
        (progn
            (gc:UcsBoundingBox ent 'llp 'urp)
            (command "_.rectangle" "_non" llp "_non" urp)
        )
    )
    (princ)
)

 

Message 7 of 14

Here you go, its a YouTube video of what is going on. 

http://youtu.be/hd2zJbKPWSM

 

 

To be quite honest, I don't quite understand that code you posted in the gc:TMatrixFromTo

 

Message 8 of 14
Lee_Mac
in reply to: Redraiderr2009

The problem is because the ActiveX addline method requires points expressed relative to WCS, and the bounding box function posted above returns points expressed relative to the active UCS as noted.

 

Try the following after loading the functions I posted earlier:

 

(defun c:try3 ( / a b ent lst spc )
    (if (setq ent (car (entsel)))
        (progn
            (gc:ucsboundingbox (vlax-ename->vla-object ent) 'a 'b)
            (setq spc (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
                  lst (list a (list (car b) (cadr a) 0.0) b (list (car a) (cadr b) 0.0))
            )
            (mapcar '(lambda ( a b ) (vlax-invoke spc 'addline (trans a 1 0) (trans b 1 0)))
                lst
                (cons (last lst) lst)
            )
        )
    )
    (princ)
)
(vl-load-com) (princ)

 

Message 9 of 14
Lee_Mac
in reply to: Lee_Mac

By the way, is this related to this thread? - Did you see my response?

 

Lee

Message 10 of 14
Redraiderr2009
in reply to: Lee_Mac

I will give that a whirl. Maybe your code for the mtext leader is a more resonable solution. I like the bounding box idea though, becuase I have some blocks of differing sizes in that appear in the visual state and have no relationship to the amount of text in the multiline attribute.

 

Do you have any other suggestions or approaches to deternine the height paraemeter of the dynamic block that I posted? Basically that is what I am doing all of this for.

 

I saw your response on about the multiline attribute and I will give that a shot.

 

Thanks for all the helpful advice.

Message 11 of 14
Redraiderr2009
in reply to: Lee_Mac

To answer your question more clearly. Yes, this is related to that post. I was just taking a different approach to the same problem.

Message 12 of 14
Lee_Mac
in reply to: Redraiderr2009

If I have correctly understood what you are looking to achieve as the end result of this program, perhaps consider the following program:

 

(defun c:blkh ( / blk ent enx hgt idx mht sel )
    (if
        (setq sel
            (ssget "_:L"
                (list '(0 . "INSERT") '(66 . 1)
                    (cons 2
                        (apply 'strcat
                            (cons "dblk_Plantlist_Shrub-12"
                                (mapcar '(lambda ( x ) (strcat ",`" x))
                                    (LM:getanonymousreferences "dblk_Plantlist_Shrub-12")
                                )
                            )
                        )
                    )
                )
            )
        )
        (repeat (setq idx (sslength sel))
            (setq blk (ssname sel (setq idx (1- idx)))
                  ent (entnext blk)
                  enx (entget  ent)
                  mht 0.0
            )
            (while (= "ATTRIB" (cdr (assoc 0 enx)))
                (if (setq hgt (cdr (assoc 43 enx)))
                    (setq mht (max mht hgt))
                )                    
                (setq ent (entnext ent)
                      enx (entget  ent)
                )
            )
            (if (< 0.0 mht)
                (LM:setdynpropvalue
                    (vlax-ename->vla-object blk)
                    "Plant_List_Row_Height"
                    (+ 2.5 mht) ;; a bit of padding
                )
            )
        )
    )
    (princ)
)

;; Get Anonymous References  -  Lee Mac
;; Returns the names of all anonymous references of a block.
;; blk - [str] Block name for which to return anon. references

(defun LM:getanonymousreferences ( blk / ano def lst rec ref )
    (setq blk (strcase blk))
    (while (setq def (tblnext "block" (null def)))
        (if
            (and (= 1 (logand 1 (cdr (assoc 70 def))))
                (setq rec
                    (entget
                        (cdr
                            (assoc 330
                                (entget
                                    (tblobjname "block"
                                        (setq ano (cdr (assoc 2 def)))
                                    )
                                )
                            )
                        )
                    )
                )
            )
            (while
                (and
                    (not (member ano lst))
                    (setq ref (assoc 331 rec))
                )
                (if
                    (and
                        (entget (cdr ref))
                        (= blk (strcase (LM:al-effectivename (cdr ref))))
                    )
                    (setq lst (cons ano lst))
                )
                (setq rec (cdr (member (assoc 331 rec) rec)))
            )
        )
    )
    (reverse lst)
)
                        
;; Effective Block Name  -  Lee Mac
;; ent - [ent] Block Reference entity

(defun LM:al-effectivename ( ent / blk rep )
    (if (wcmatch (setq blk (cdr (assoc 2 (entget ent)))) "`**")
        (if
            (and
                (setq rep
                    (cdadr
                        (assoc -3
                            (entget
                                (cdr
                                    (assoc 330
                                        (entget
                                            (tblobjname "block" blk)
                                        )
                                    )
                                )
                               '("AcDbBlockRepBTag")
                            )
                        )
                    )
                )
                (setq rep (handent (cdr (assoc 1005 rep))))
            )
            (setq blk (cdr (assoc 2 (entget rep))))
        )
    )
    blk
)

;; Set Dynamic Block Property Value  -  Lee Mac
;; Modifies the value of a Dynamic Block property (if present)
;; blk - [vla] VLA Dynamic Block Reference object
;; prp - [str] Dynamic Block property name (case-insensitive)
;; val - [any] New value for property
;; Returns: [any] New value if successful, else nil

(defun LM:setdynpropvalue ( blk prp val )
    (setq prp (strcase prp))
    (vl-some
       '(lambda ( x )
            (if (= prp (strcase (vla-get-propertyname x)))
                (progn
                    (vla-put-value x (vlax-make-variant val (vlax-variant-type (vla-get-value x))))
                    (cond (val) (t))
                )
            )
        )
        (vlax-invoke blk 'getdynamicblockproperties)
    )
)

(vl-load-com)
(princ)

 

Many of the above functions have been sourced from my site:

 

Get Anonymous References

Effective Block Name

Set Dynamic Block Property Value

 

As a quick demonstration:

 

blockheight.gif

Message 13 of 14
Redraiderr2009
in reply to: Lee_Mac

Wow! Nice! Here was the result.
http://youtu.be/XlbK3SPnh9I
Message 14 of 14
Lee_Mac
in reply to: Redraiderr2009

Can't find what you're looking for? Ask the community or share your knowledge.

Post to forums  

Autodesk Design & Make Report

”Boost