Ceiling grid

[vipin_nair]

Hi ,

If there is any programm for making ceiling grid? How can we use array comand in programming .. Please revert back as soon as possible..Because I am trying to do the same.


Thank you..

[CAB2k]

Here is a simple one you can modify.
;; CAB 11/27/2006
;; select area via a rectangle
;; No error checking
(defun C:CeilingGrid (/ borderH borderW Height Layer ll p1
p2 TitleH TitleW Up ur Width Xcount
Ycount
)
(vl-load-com)
(setq TitleW 24
TitleH 48
layer "0" ;; <---<< layer for Grid
)

(if (and (setq p1 (getpoint "\nPick first corner point"))
(setq p2 (getcorner p1 "\nPick opposite corner point"))
)
(progn
(vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
(setq ll (list (apply 'min (mapcar 'car (list p1 p2)))
(apply 'min (mapcar 'cadr (list p1 p2)))
)
)
(setq ur (list (apply 'max (mapcar 'car (list p1 p2)))
(apply 'max (mapcar 'cadr (list p1 p2)))
)
)

(setq Height (abs (- (cadr ur) (cadr ll)))
Width (abs (- (car ur) (car ll)))
)

(setq Xcount (/ Width (float TitleW))
Ycount (/ Height (float TitleH))
)

(setq borderW (- Xcount (fix Xcount)))
(cond
((equal borderW 0.0 0.001)
(setq borderW (/ TitleW 2.0))
)
((>= borderW 0.5)
(setq borderW (* (/ borderW 2.0) TitleW)
Xcount (1+ Xcount)
)
)
((setq borderW (* (/ (1+ borderW) 2.0) TitleW))
)
)

(setq borderH (- Ycount (fix Ycount)))
(cond
((equal borderH 0.0 0.001)
(setq borderH (/ TitleH 2.0))
)
((>= borderH 0.5)
(setq borderH (* (/ borderH 2.0) TitleH)
Ycount (1+ Ycount)
)
)
((setq borderH (* (/ (1+ borderH) 2.0) TitleH))
)
)

(setq up (/ pi 2)
p1 (polar ll 0 borderW) ; first vertical line start
p2 (polar ll up borderH) ; first horz line start
)

(repeat (fix Xcount)
(entmake (list (cons 0 "LINE")
(cons 6 "BYLAYER")
(cons 8 layer)
(cons 10 (trans p1 1 0))
(cons 11 (trans (polar p1 up Height) 1 0))
)
)
(setq p1 (polar p1 0 TitleW))
)
(repeat (fix Ycount)
(entmake (list (cons 0 "LINE")
(cons 6 "BYLAYER")
(cons 8 layer)
(cons 10 (trans p2 1 0))
(cons 11 (trans (polar p2 0 Width) 1 0))
)
)
(setq p2 (polar p2 up TitleH))
)
(vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
)
)
(princ)
)
(prompt "\n*** Ceiling Grid loaded, Enter CelingGrid to run.***")
(princ)

[vipin_nair]

Hi, everyone

It's cool..... It is very useful. Actually my problem is that we are keeping a symmetry for making the grids. Can u tell me that what changes could make this program to draw grids in 'even' numbers.Thanks again.

[CAB2k]

In the code:
(setq TitleW 24
TitleH 48
layer "0" ;; <---<< layer for Grid
)

Replace the 48 with 24 to get a 24 by 24 unit grid.

[tedg]

In the code:
(setq TitleW 24
TitleH 48
layer "0" ;; <---<< layer for Grid
)Replace the 48 with 24 to get a 24 by 24 unit grid.
Howdy CAB2k, I like your lisp routine, I assume it's in vlisp?
I don't know much about vlisp, I'm an old school lisper at an intermediate level.
(I really need to catch up on vlisp) :Oops:

How can your routine create the layer "A-CLNG-GRID" if it doesn't exist?

I would have it do a tblsearch to look for it, and create it if it doesn't exist.
I don't know if this works in vlisp, or if there's a cleaner way (I don't want to "muddy up" the code).


(SETQ LR1 (TBLSEARCH "LAYER" "A-CLNG-GRID"))
(IF (= LR1 NIL)
(COMMAND "LAYER" "MAKE" "A-CLNG-GRID" "COLOR" "11" "" ""))

I haven't tried it yet, assuming there's a better way.

[CAB2k]

Use eather one:
;; Make or Update layer
(defun make_lay (n c lt / l)
;;(make_lay "Layer11" nil nil)
;;(make_lay "Layer11" 2 "Continuous")
(if (tblsearch "Layer" n)
(setq l (vlax-ename->vla-object (tblobjname "Layer" n)))
(setq l (vla-add (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))) n))
)
(if c (vla-put-color l c)(vla-put-color l 7))
(if lt(vla-put-Linetype l lt)(vla-put-Linetype l "Continuous"))
)

(defun LayerMake(lyrname Color ltype)
(if (tblsearch "LAYER" lyrname)
(command "._Layer" "_Thaw" lyrname "_On" lyrname "_UnLock" lyrname "_Set" lyrname "")
(command "._Layer" "_Make" lyrname "_Color"
(if (or (null color)(= Color "")) "_White" Color) lyrname
"LT" (if (or (null ltype)(= ltype "")) "Continuous" ltype) lyrname "")
)
)

[tedg]

Use eather one:

Thanks dude.
:beer:

[CADDmanVA]

I don't do ceiling grids here, but I do a lot of concrete scoring patterns. Try using the custom hatch option. It works great, and the ability to set the origin always guarantees a perfectly spaced grid.

[vipin_nair]

Hi ,

I got it , but we are making grids in 600 by 600 units. I am confusing where to make changes in our routine to get grids in even numbers both vertical/horizontal while keeping TitleW and TitleH are same (600).

[ron_09812001]

A NON RECTANGULAR ROOM WILL BE ANOTHER CHALLENGE....POSSIBLE?

[CAB2k]

Hi ,

I got it , but we are making grids in 600 by 600 units. I am confusing where to make changes in our routine to get grids in even numbers both vertical/horizontal while keeping TitleW and TitleH are same (600).

For 600x600 unit grid use this:

(setq TitleW 600 ; <---<< Grid Width
TitleH 600 ; <---<< Grid Height
layer "0" ;; <---<< layer for Grid
)

[CAB2k]

A NON RECTANGULAR ROOM WILL BE ANOTHER CHALLENGE....POSSIBLE?

Yes that is a challange & best handeled with a hatch pattern. The hatch works by setting the Scale, Angle, and SnapBase.

I have this code, let me see if I can find the origin of it.

<edit>
Here is the original thread: http://www.theswamp.org/index.php?topic=4269.0

(defun c:cgrid (/ pt1 elast elist ptlist max_x min_x max_y min_y en snpbase osm ang hbp)
;; Modify Hatch Base Point
(defun hbp (elst obp / nbp)
(while (setq nbp (getpoint obp "\nSelect new basepoint or Enter to Quit: "))
(setq elst (subst (cons 43 (car nbp))
(assoc 43 elst) ; new x basepoint
elst
)
)
(setq elst (subst (cons 44 (cadr nbp))
(assoc 44 elst) ; new y basepoint
elst
)
)
(entmod elst)
(setq obp nbp)
) ;end while
) ; end defun

(command "undo" "begin")

(prompt "\nPick points to define the room. Enter when done.")
(if (setq pt1 (getpoint))
(progn
(setq elast (entlast))
(command "PLINE" pt1)
(while (> (getvar "CMDACTIVE") 0)
(command pause)
)
)
)
(setq osm (getvar "OSMODE"))
(setvar "OSMODE" 512)

(if (not (eq elast (setq en (entlast))))
(progn
(setq elist (entget en)
ptlist (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) elist))
)

(setq max_x (apply 'max (mapcar 'car ptlist))
min_x (apply 'min (mapcar 'car ptlist))
max_y (apply 'max (mapcar 'cadr ptlist))
min_y (apply 'min (mapcar 'cadr ptlist))
)

(setq snpbase (list (+ (/ (abs (- max_x min_x)) 2) min_x)
(+ (/ (abs (- max_y min_y)) 2) min_y)
)
)
(command "snapbase" snpbase)
(setq ang (cond ((getangle "\nPick 2 points for hatch alignment. Enter=0"))
(0)
)
)
(setq ang (* 180.0 (/ ang pi)))
(command "_hatch" "u" ang "24" "y" en "")
(command "snapbase" "0,0")
(setvar "OSMODE" 0)
(hbp (entget (entlast)) snpbase)
)
)
(setvar "OSMODE" osm)
(command "undo" "end")
(princ)
)
(prompt "\nLighting Grid Loaded, Enter cgrid to run.")
(princ)

[tedg]

Hi ,

I got it , but we are making grids in 600 by 600 units. I am confusing where to make changes in our routine to get grids in even numbers both vertical/horizontal while keeping TitleW and TitleH are same (600).

In the code:
(setq TitleW 24
TitleH 48
layer "0" ;; <---<< layer for Grid
)Replace the 48 with 24 to get a 24 by 24 unit grid.

I don't know for sure but I think you just need to change these sizes:
(setq TitleW 600
TitleH 600
layer "0" ;; <---<< layer for Grid
)

You're using metric I assume?

**** Sorry for the redundant post *******
**** I didn't read on to see Cab2k had already answered it *****

[vipin_nair]

Hi Everyone,

(setq TitleW 600
TitleH 600
layer "0" ;; <---<< layer for Grid
)

I have already checked this. But you will not get grids in even numbers in different areas. Please check it.Thank you.

[CAB2k]

Post a DWG with the incorrect Grid.

[vipin_nair]

Hi,
here is the dwg. file. In the dwg. file u will get even numbers of grids in fig.2 but in fig.1
u can find the problem.Thank u again

[CAB2k]

I don't believe that is accepted practice, but repace code section with this:
(setq borderW (- Xcount (fix Xcount)))
(cond
((equal borderW 0.0 0.001)
;;(setq borderW (/ TitleW 2.0)) ; old code
(setq borderW TitleW ; new code
Xcount (1- Xcount)) ; new code
)
((>= borderW 0.5)
(setq borderW (* (/ borderW 2.0) TitleW)
Xcount (1+ Xcount)
)
)
((setq borderW (* (/ (1+ borderW) 2.0) TitleW))
)
)

(setq borderH (- Ycount (fix Ycount)))
(cond
((equal borderH 0.0 0.001)
;;(setq borderH (/ TitleH 2.0)) ; old code
(setq borderH TitleH ; new code
Ycount (1- Ycount)) ; new code
)
((>= borderH 0.5)
(setq borderH (* (/ borderH 2.0) TitleH)
Ycount (1+ Ycount)
)
)
((setq borderH (* (/ (1+ borderH) 2.0) TitleH))
)
)

[ron_09812001]

Yes that is a challange & best handeled with a hatch pattern. The hatch works by setting the Scale, Angle, and SnapBase.

I have this code, let me see if I can find the origin of it.

[/CODE]



***ive seen your other works in the swamp and cadalyst, you are very good CAB.

[ron_09812001]

read the history of this cgrid, it would be better i think if we can pan the hatch dynamically, just like panning inside a viewport...what can you say cab?

[CAB2k]

;; CAB 10.29.2007
;; Hatch Base Point Edit
(defun c:HBPEdit (/ ent elst x y bp)
(command "._undo" "_begin")
(if (and (setq ent (car (entsel "\nSelect hatch for new base point.")))
(= (cdr (assoc 0 (setq elst (entget ent)))) "HATCH")
)
(while (setq bp (getpoint "\nSelect new basepoint: "))
(setq x (car bp)
y (car (cdr bp))
)
(setq elst (subst (cons 43 x) (assoc 43 elst) elst))
(setq elst (subst (cons 44 y) (assoc 44 elst) elst))
(entmod elst)
)
(prompt "\nNot a hatch, bye.")
)
(command "._undo" "_end")
(princ)
)

[ron_09812001]

This gets better and better, good thinking Cab, thanks.

[vipin_nair]

Hi,

Good job, but I think you forget to check your routine after redifining that. It is sure that u will get even number of grids horizontally in fig.1 but u will not get it vertically. And also you can check it in various size of rectangles.

[CAB2k]

Vipin,
Your rules for defining the grid are different from mine.
I created the routine so that the border tiles would be:
Equal in size for left & right
Equal in size for top & bottom
No border tile cut will be less than 0.25 tile size, this is to prevent a narrow cut.
No border tile cut will be a full size piece, if the wall bows out it would require a thin cut.

What are the rules for your tile ceiling?

[vipin_nair]

Hi Cab,
Thanks for your replay. We are keeping the symmetry like u said,
border tiles would be Equal in size for left & right
Equal in size of top & bottom.
Keeping 600x600 units for grids
Only difference is that we are keeping even numbers of grids in vertically and horizontally . I already had one routine. Here is the routine and dwg. file. Please go through this. Thanks again.

[CAB2k]

Here you go.
;; CAB 10.29.2007
;; this variation places the center of a tile in the center of the room
;; select area via a rectangle
;; No error checking
(defun C:CeilingGrid (/ borderH borderW Height Layer ll p1
p2 TitleH TitleW Up ur Width Xcount
Ycount
)
(vl-load-com)
(setq TitleW 600
TitleH 600
layer "0" ;; <---<< layer for Grid
)

(if (and (setq p1 (getpoint "\nPick first corner point"))
(setq p2 (getcorner p1 "\nPick opposite corner point"))
)
(progn
(vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
(setq ll (list (apply 'min (mapcar 'car (list p1 p2)))
(apply 'min (mapcar 'cadr (list p1 p2)))
)
)
(setq ur (list (apply 'max (mapcar 'car (list p1 p2)))
(apply 'max (mapcar 'cadr (list p1 p2)))
)
)

(setq Height (abs (- (cadr ur) (cadr ll)))
Width (abs (- (car ur) (car ll)))
)

(setq Xcount (/ Width (float TitleW))
Ycount (/ Height (float TitleH))
)

(setq borderW (- Xcount (fix Xcount)))
(if (equal (rem (fix Xcount) 2) 0 0.001) ; even # of whole tiles
(setq borderW (1+ borderW)
Xcount (1- Xcount))
)

(cond
((equal borderW 0.0 0.001) ; if full tile border make it 1/2 tile
(setq borderW TitleW
Xcount (1- Xcount))
)
((>= borderW 0.5)
(setq borderW (* (/ borderW 2.0) TitleW)
Xcount (1+ Xcount)
)
)
((setq borderW (/ (* borderW TitleW) 2.0)
Xcount (1+ Xcount))
)
)

(setq borderH (- Ycount (fix Ycount)))
(if (equal (rem (fix Ycount) 2) 0 0.001) ; even # of whole tiles
(setq borderH (1+ borderH)
Ycount (1- Ycount))
)
(cond
((equal borderH 0.0 0.001)
(setq borderH TitleH
Ycount (1- Ycount))
)
((>= borderH 0.5)
(setq borderH (* (/ borderH 2.0) TitleH)
Ycount (1+ Ycount)
)
)
((setq borderH (/ (* borderH TitleW) 2.0)
Ycount (1+ Ycount))
)
)

(setq up (/ pi 2)
p1 (polar ll 0 borderW) ; first vertical line start
p2 (polar ll up borderH) ; first horz line start
)

(repeat (fix Xcount)
(entmake (list (cons 0 "LINE")
(cons 6 "BYLAYER")
(cons 8 layer)
(cons 10 (trans p1 1 0))
(cons 11 (trans (polar p1 up Height) 1 0))
)
)
(setq p1 (polar p1 0 TitleW))
)
(repeat (fix Ycount)
(entmake (list (cons 0 "LINE")
(cons 6 "BYLAYER")
(cons 8 layer)
(cons 10 (trans p2 1 0))
(cons 11 (trans (polar p2 0 Width) 1 0))
)
)
(setq p2 (polar p2 up TitleH))
)
(vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
)
)
(princ)
)
(prompt "\n*** Ceiling Grid loaded, Enter CelingGrid to run.***")
(princ)

[jakob_k]

hi,
i used to do ceiling grids in the past (different job now).
instead of a routine, i'd use a hatch (ansi37) at 45 degrees and an appropriate scale.
i use to also use an offset for the hatch to center in the room, but that's now built into the hatch dialog box. also, if you do this approach, check your "options" dialog under the "drafting" tab, in the low left corner UNCHECK the "ignore hatch objects" so you can snap to relevant intersections.

hope this helps,
karl

[vipin_nair]

Hi Cab,
Thank you. Great job. This is very helpful for us. Is it possible that user will get grids in user defined "layer " and "color". In your routine grids are created always in "0" layer.I tried to replace "0" with "ceil-grid". but I need the color also to be changed.

[CAB2k]

The tile size & layer are set hrer in the code.
(setq TitleW 600 ; Tile Width
TitleH 600 ; Tile Height
layer "0" ;; <---<< layer for Grid
)
As for a color change you will need to set the current settings first & then restore them.
Or change the grid entities as they are created. That is easy enough, be right back.

[CAB2k]

With your layer & color:
;; CAB 10.31.2007
;; this variation places the center of a tile in the center of the room
;; select area via a rectangle
;; No error checking
(defun C:CeilingGrid (/ borderH borderW Height Layer ll p1
p2 TitleH TitleW Up ur Width Xcount
Ycount
)
(vl-load-com)
;; MakeLayer returns nil if make failed
(defun MakeLayer (lyrname acDoc / obj)
(vl-load-com)
(if
(not
(vl-catch-all-error-p
(setq obj (vl-catch-all-apply 'vla-add
(list (vla-get-layers acDoc) lyrname)))
)
)
obj
)
)

(setq TitleW 600
TitleH 600
layer "Ceil-grd-Lines" ;; <---<< layer for Grid
gColor 6 ;; <---<< color for grid
)

(if (setq lyr (MakeLayer layer (vla-get-activedocument (vlax-get-acad-object))))
(progn
(vla-put-color lyr acred) ;change the color of the new layer
(vla-put-plottable lyr :vlax-true)
(vla-put-LineType lyr "Continuous") ;change the linetype of the new layer
(vla-put-Freeze lyr 0) ;thaw the new layer
(vla-put-LayerOn lyr -1) ;turn the new layer on
(vla-put-Lock lyr 0) ;unlock the new layer
(vlax-release-object lyr)
)
)


(if (and (setq p1 (getpoint "\nPick first corner point"))
(setq p2 (getcorner p1 "\nPick opposite corner point"))
)
(progn
(vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
(setq ll (list (apply 'min (mapcar 'car (list p1 p2)))
(apply 'min (mapcar 'cadr (list p1 p2)))
)
)
(setq ur (list (apply 'max (mapcar 'car (list p1 p2)))
(apply 'max (mapcar 'cadr (list p1 p2)))
)
)

(setq Height (abs (- (cadr ur) (cadr ll)))
Width (abs (- (car ur) (car ll)))
)

(setq Xcount (/ Width (float TitleW))
Ycount (/ Height (float TitleH))
)

(setq borderW (- Xcount (fix Xcount)))
(if (equal (rem (fix Xcount) 2) 0 0.001) ; even # of whole tiles
(setq borderW (1+ borderW)
Xcount (1- Xcount))
)

(cond
((equal borderW 0.0 0.001) ; if full tile border make it 1/2 tile
(setq borderW TitleW
Xcount (1- Xcount))
)
((>= borderW 0.5)
(setq borderW (* (/ borderW 2.0) TitleW)
Xcount (1+ Xcount)
)
)
((setq borderW (/ (* borderW TitleW) 2.0)
Xcount (1+ Xcount))
)
)

(setq borderH (- Ycount (fix Ycount)))
(if (equal (rem (fix Ycount) 2) 0 0.001) ; even # of whole tiles
(setq borderH (1+ borderH)
Ycount (1- Ycount))
)
(cond
((equal borderH 0.0 0.001)
(setq borderH TitleH
Ycount (1- Ycount))
)
((>= borderH 0.5)
(setq borderH (* (/ borderH 2.0) TitleH)
Ycount (1+ Ycount)
)
)
((setq borderH (/ (* borderH TitleW) 2.0)
Ycount (1+ Ycount))
)
)

(setq up (/ pi 2)
p1 (polar ll 0 borderW) ; first vertical line start
p2 (polar ll up borderH) ; first horz line start
)

(repeat (fix Xcount)
(entmake (list (cons 0 "LINE")
(cons 6 "BYLAYER")
(cons 8 layer)
(cons 62 gcolor)
(cons 10 (trans p1 1 0))
(cons 11 (trans (polar p1 up Height) 1 0))
)
)
(setq p1 (polar p1 0 TitleW))
)
(repeat (fix Ycount)
(entmake (list (cons 0 "LINE")
(cons 6 "BYLAYER")
(cons 8 layer)
(cons 62 gcolor)
(cons 10 (trans p2 1 0))
(cons 11 (trans (polar p2 0 Width) 1 0))
)
)
(setq p2 (polar p2 up TitleH))
)
(vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
)
)
(princ)
)
(prompt "\n*** Ceiling Grid loaded, Enter CelingGrid to run.***")
(princ)

[Richard.Kent]

How about a free hatch pattern to do it?
http://www.dotsoft.com/acadhatch.htm

[vipin_nair]

Hi Cab ,

Thanks to you, I will back.

[TeamRPM]

why not use a rectangular or square hatch pattern and scale it to the desired size grid? before hatching use 'snapbase' to set your grid start point. quick and simple. the trim command seems to work quite well for any odd custom conditions that would require a void in the grid.

[d_m_hopper]

I have been trying to create an if statement based on a key word to use with this routine

(initget "English Metric") ; ask for input
(setq Inp (getkword "\nWhat are the units of measure? [English/Metric] <English>: "))
(or Inp (setq Inp "English")
)

(vl-load-com)
;; MakeLayer returns nil if make failed
(defun MakeLayer (lyrname acDoc / obj)
(vl-load-com)
(if
(not
(vl-catch-all-error-p
(setq obj (vl-catch-all-apply 'vla-add
(list (vla-get-layers acDoc) lyrname)))
)
)
obj
)
)
(if (= Inp "Metric")
(progn
(setq TitleW 610)
(setq TitleH 610)
layer "cpdp" ;; <---<< layer for Grid
gColor 1 )) ;; <---<< color for grid

(if (= Inp "English")
(progn
(setq TitleW 24)
(setq TitleH 24)
layer "cpdp" ;; <---<< layer for Grid
gColor 1 ;; <---<< color for grid
))

just a snippet of editted code from finished routine from this thread....if statements and me do not get along btw

[CAB2k]

Try this:
(if (= Inp "Metric")
(setq TitleW 610
TitleH 610)
layer "cpdp" ; <---<< layer for Grid
gColor 1 ; <---<< color for grid
)
;; else set for English
(setq TitleW 24
TitleH 24
layer "cpdp" ; <---<< layer for Grid
gColor 1 ; <---<< color for grid
)
)

[d_m_hopper]

Try this:
(if (= Inp "Metric")
(setq TitleW 610
TitleH 610)<--removed
layer "cpdp" ; <---<< layer for Grid
gColor 1 ; <---<< color for grid
)
;; else set for English
(setq TitleW 24
TitleH 24
layer "cpdp" ; <---<< layer for Grid
gColor 1 ; <---<< color for grid
)
)




made one fix and it works great, thanks for the help Cab

[CAB2k]

Glad I could help.

[d_m_hopper]

Glad I could help.

you always have been a big help :mrgreen: