Jump to content

Auto fit the 3d drawings in the each viewport of each layout


Sekar

Recommended Posts

Ok a few things for it to work you have to work in UCS WORLD. The text must exist within the cupboards, I also set it to z=0

image.thumb.png.413d92669fa88547b4712e9140c262a2.png

 When you select objects it also looks for the text within a new box containing all the parts.

image.png.826b5e6b2cdbb9fc3cd5e1d7d1fbe639.png

2nd problem in new sample dwg you changed the name of the default layout I used Ph00. Can do a enter name but will leave that to you. The other option is can make layout names Ph01 Ph02 etc. 

 

I updated the code.

; https://www.cadtutor.net/forum/topic/78282-auto-fit-the-3d-drawings-in-the-each-viewport-of-each-layout/

(defun c:wow ( / box ss x ent tabn ans)
(if (not AH:Butts)(load "Multi radio buttons.lsp")) ; loads the program if not loaded already
(defun LM:bigbox (selobj / obj spc )
    (if
        (setq box (LM:ssboundingbox selobj))
        (progn
            (setq spc
                (vlax-get-property (vla-get-activedocument (vlax-get-acad-object))
                    (if (= 1 (getvar 'cvport))
                        'paperspace
                        'modelspace
                    )
                )
            )
            (if (equal 0.0 (apply '- (mapcar 'caddr box)) 1e-6)
                (progn
                    (setq obj
                        (vlax-invoke spc 'addlightweightpolyline
                            (apply 'append
                                (mapcar '(lambda ( x ) (mapcar '(lambda ( y ) ((eval y) box)) x))
                                   '(
                                        (caar   cadar)
                                        (caadr  cadar)
                                        (caadr cadadr)
                                        (caar  cadadr)
                                    )
                                )
                            )
                        )
                    )
                    (vla-put-closed obj :vlax-true)
                    (vla-put-elevation obj (caddar box))
                )
                (apply 'vlax-invoke 
                    (vl-list* spc 'addbox
                        (apply 'mapcar (cons '(lambda ( a b ) (/ (+ a b) 2.0)) box))
                        (apply 'mapcar (cons '- (reverse box)))
                    )
                )
            )
        )
    )
    (princ)
)
(defun LM:ssboundingbox (sel / idx llp ls1 ls2 obj urp)
    (repeat (setq idx (sslength sel))
        (setq obj (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))))
        (if (and (vlax-method-applicable-p obj 'getboundingbox)
                 (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'llp 'urp))))
            )
            (setq ls1 (mapcar 'min (vlax-safearray->list llp) (cond (ls1) ((vlax-safearray->list llp))))
                  ls2 (mapcar 'max (vlax-safearray->list urp) (cond (ls2) ((vlax-safearray->list urp))))
            )
        )
    )
    (if (and ls1 ls2) (list ls1 ls2))
)
(setvar 'ctab "Model")
(setq x (- (getint "\Enter start number ") 1))
(prompt "select a group of cupboards")
(while (setq ss (ssget))
(LM:bigbox ss)
(setq ent (entlast))
(setq pt1 (list (car (car box))(cadr (car box))) pt2 (list (car (cadr box))(cadr (cadr box))))
(setq ss2 (ssget "CP" (list pt1 pt2) '((0 . "*TEXT"))))
(setq str (cdr (assoc 1 (entget (ssname ss2 0)))))
(setq tabn (strcat "Ph" (rtos (setq x (1+ x)) 2 0)))
(command "layout" "c" "Ph00" tabn)
(setvar 'ctab tabn)
(setq obj  (vlax-ename->vla-object (ssname (ssget "X" (list (cons 0 "Viewport")(cons 410 tabn))) 0)))
(setq ans (ah:butts 1 "V"   '("Choose 3d direction " "3d Front" "3d Back" "3d Left" "3d Right" "Front" "BacK" "Left" "Right")))
(cond
((= ans "3d Front")(vla-put-direction obj (list -1 -1 -1)))
((= ans "3d Back") (vla-put-direction obj  (list 1 1 1)))
((= ans "3d Left") (vla-put-direction obj (list -1 1 1)))
((= ans "3d Right")(vla-put-direction obj (list 1 -1 1)))
((= ans "Front")   (vla-put-direction obj (list 0 -1 0)))
((= ans "Back")    (vla-put-direction obj  (list 0 1 0)))
((= ans "Left")    (vla-put-direction obj (list -1 0 0)))
((= ans "Right")   (vla-put-direction obj (list 1 0 0)))
)
(command "Mspace")
(setq pt1 (car box) pt2 (cadr box))
(setq mp (mapcar '* (mapcar '+ pt1 pt2)'(0.5 0.5 0.5)))
(command "zoom" "c" mp 2000)
(command "zoom" "OB" ent "")
(command "erase" ent "")
(command "pspace")
(command "mtext" (list 10 185) (list 150 190) str "")
(setvar 'ctab "Model")
(prompt "select a group of cupboards Enter to exit ")
)
(setq cnt 1 doc (vla-get-activedocument (vlax-get-acad-object)))
(foreach lay (acad_strlsort (vl-remove "Model" (layoutlist)))
   (vla-put-taborder (vla-item (vla-get-layouts doc) lay) cnt)
   (setq cnt (1+ cnt))
)
(princ)
)
(c:wow)

 

Edited by BIGAL
Link to comment
Share on other sites

Ok a couple of rules 

UCS W Plan

Make sure mtext Z is zero use properties to reset.

The master layout name is Ph00, we can discuss later different names.

 

 I changed code to check for text,

(command "mtext" (list 10 185) (list 150 190) str "")
change to
(If (= str nil)
  (alert "no text label available ")
  (command "mtext" (list 10 185) (list 150 190) str "")
)

 Please try again.

Edited by BIGAL
Link to comment
Share on other sites

Hi.,

I tried it, but getting the same error, i placed the text in the Z=0, and within the specified area coordinates first corner at 10,185 and second corner at 150,190.

Link to comment
Share on other sites

Hi.,

if you dont mind can you make a short video on placement of text. i am not getting it. i am getting error only.

 

; https://www.cadtutor.net/forum/topic/78282-auto-fit-the-3d-drawings-in-the-each-viewport-of-each-layout/

(defun c:wow ( / box ss x ent tabn ans)
(if (not AH:Butts)(load "Multi radio buttons.lsp")) ; loads the program if not loaded already

;; Selection Set Bounding Box  -  Lee Mac
;; Returns a list of the lower-left and upper-right WCS coordinates of a
;; rectangular frame bounding all objects in a supplied selection set.
;; sel - [sel] Selection set for which to return bounding box
(defun LM:bigbox (selobj / obj spc )
    (if
        (setq box (LM:ssboundingbox selobj))
        (progn
            (setq spc
                (vlax-get-property (vla-get-activedocument (vlax-get-acad-object))
                    (if (= 1 (getvar 'cvport))
                        'paperspace
                        'modelspace
                    )
                )
            )
            (if (equal 0.0 (apply '- (mapcar 'caddr box)) 1e-6)
                (progn
                    (setq obj
                        (vlax-invoke spc 'addlightweightpolyline
                            (apply 'append
                                (mapcar '(lambda ( x ) (mapcar '(lambda ( y ) ((eval y) box)) x))
                                   '(
                                        (caar   cadar)
                                        (caadr  cadar)
                                        (caadr cadadr)
                                        (caar  cadadr)
                                    )
                                )
                            )
                        )
                    )
                    (vla-put-closed obj :vlax-true)
                    (vla-put-elevation obj (caddar box))
                )
                (apply 'vlax-invoke 
                    (vl-list* spc 'addbox
                        (apply 'mapcar (cons '(lambda ( a b ) (/ (+ a b) 2.0)) box))
                        (apply 'mapcar (cons '- (reverse box)))
                    )
                )
            )
        )
    )
    (princ)
)

(defun LM:ssboundingbox (sel / idx llp ls1 ls2 obj urp)
    (repeat (setq idx (sslength sel))
        (setq obj (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))))
        (if (and (vlax-method-applicable-p obj 'getboundingbox)
                 (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'llp 'urp))))
            )
            (setq ls1 (mapcar 'min (vlax-safearray->list llp) (cond (ls1) ((vlax-safearray->list llp))))
                  ls2 (mapcar 'max (vlax-safearray->list urp) (cond (ls2) ((vlax-safearray->list urp))))
            )
        )
    )
    (if (and ls1 ls2) (list ls1 ls2))
)


(setvar 'ctab "Model")
(setq x (- (getint "\Enter start number ") 1))

(prompt "select a group of cupboards")
(while (setq ss (ssget))
  (LM:bigbox ss)
  (setq ent (entlast))
  (setq pt1 (list (car (car box))(cadr (car box))) pt2 (list (car (cadr box))(cadr (cadr box))))
  (setq ss2 (ssget "CP" (list pt1 pt2) '((0 . "*TEXT"))))
  (setq str (cdr (assoc 1 (entget (ssname ss2 0)))))
  (setq tabn (strcat "Ph" (rtos (setq x (1+ x)) 2 0)))
  (command "layout" "c" "Ph00" tabn)
  (setvar 'ctab tabn)
  (setq ans (ah:butts 1 "V"   '("Choose 3d direction " "3d Front" "3d Back" "3d Left" "3d Right" "Front" "BacK" "Left" "Right"))) 	; ans holds the button picked value as 

a string
  (command "Mspace")
  (cond
   ((= ans "3d Front")(command "vpoint" "-1,-1,1"))
   ((= ans "3d Back")(command  "vpoint" "1,1,1"))
   ((= ans "3d Left")(command  "vpoint" "1,1,1"))
   ((= ans "3d Right")(command  "vpoint" "1,-1,1"))
   ((= ans "Front")(command  "vpoint" "0,-1,0"))
   ((= ans "Back")(command  "vpoint" "0,1,0"))
   ((= ans "Left")(command  "vpoint" "-1,0,0"))
   ((= ans "Right")(command  "vpoint" "1,0,0"))
  )

  (setq pt1 (car box) pt2 (cadr box))
  (setq mp (mapcar '* (mapcar '+ pt1 pt2)'(0.5 0.5 0.5)))
  (command "zoom" "c" mp 2000)
  (command "zoom" "OB" ent "")
  (command "erase" ent "")
  (command "pspace")
  (If (= str nil)
  (alert "no text label available ")
  (command "mtext" (list 10 185) (list 150 190) str "")
)
  (setvar 'ctab "Model")
  (prompt "select a group of cupboards Enter to exit ")
)

; sort tabs by CAB
;; 07/14/2005  CAB 

(setq cnt 1
    doc (vla-get-activedocument (vlax-get-acad-object))
)
(foreach lay (acad_strlsort (vl-remove "Model" (layoutlist)))
   (vla-put-taborder (vla-item (vla-get-layouts doc) lay) cnt)
   (setq cnt (1+ cnt))
)
(princ)
)

(c:wow)

 

image.thumb.png.03cc773209ff2eff06666d9eae07e01e.png

Edited by Sekar
Adding the code
Link to comment
Share on other sites

It will be the default text size and style being used in the Mtext line. Mine was using 2.5 so did not see issue but did make it do weird things to the size and style.

 

Look for the ctab line and add the 2 lines about setting text style and height.

(setvar 'ctab "Model")
(setvar 'textsize 2.5)
(setvar 'textstyle "Text R")

 

Edited by BIGAL
Link to comment
Share on other sites

hi.,

 

i am getting this error some times

----- LISP : Call Stack -----
; [0]...C:WOW <<--
;
; ----- Error around expression -----
; (SSNAME SS2 0)
; in file : 
; J:\autocad\Lisp\Layout\wow.lsp
;
; error : bad argument type <NIL> ; expected SELECTIONSET at [ssname]

 

also i am getting layout as even 3d front is selected. Attached herewith the file. am i wrong somewhere

image.png.e80b985d58123405a0c2098da07a8315.png

26.09.23_01 - Copy.dwg

Edited by Sekar
adding details
Link to comment
Share on other sites

I had another go at it, I have changed the view direction code I did get some problems and not sure why , seems ok with your dwg, so please download again. Dont forget you can change the function name from WOW. Download code above.

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...