Topic: Diffuser lisp

[Royalchill]

I am looking for a lisp routine that will let me insert a diffuser/grille to the size I specifie, like an 8x6, 12x8 etc. plus create a layer name. Any help email me gab@sweng.com. Thanks alot

[hudster]

why not draw it 1mm by 1mm, then scale it to the size you want, 400, 400 etc etc.

Thats what I do for these things.

[JohnK]

This is the wrong place for this post. ...I will be moving it to the AutoLisp forum.

*SMACK!*

[JohnK]

We have now arrived at our final destination, I hope everyone enjoyed the ride.

[t-bear]

Blocks library!?!   Once made, you never need draw one again............just a thought.

[hyposmurf]

If your on 2004 upwards then create a drawing of them all, then use this to create a tool pallete, as far as I remember you can preset the layer for them to.

[Mark]

This will get you started.

Code: [Select]

(defun c:diffu (/ pt_int ang size_h size_w pt_tmp pt_t1 pt_t2 pt_t3
pt_t4)

  (command "_.layer" "Make" "_diffuser" "")

  (if (setq pt_int (getpoint "\nPick Insertion Point: "))
    (if (setq ang (getangle pt_int "\nAngle: "))
      (if (setq size_h (getreal "\nHeight: "))
(if (setq size_w (getreal "\nWidth: "))
  (progn
    (setq pt_tmp (polar pt_int ang (/ size_h 2))
  pt_t1 (polar pt_tmp (+ ang (* pi 0.5)) (/ size_w 2))
  pt_t2 (polar pt_t1 (angle pt_tmp pt_int) size_h)
  pt_t3 (polar pt_t2 (angle pt_t1 pt_tmp) size_w)
  pt_t4 (polar pt_t3 (angle pt_int pt_tmp) size_h)
    )
    (command "_.LINE" pt_t1 pt_t2 pt_t3 pt_t4 "CLOSE")
  )
)
      )
    )
  )

  (princ)
)

[Adesu]

As add corrected,here this code

Code: [Select]


(defun c:diffu (/ lay pt_int ang size_h size_w pt_tmp pt_t1 pt_t2 pt_t3 pt_t4)
  (setq lay (tblsearch "layer" "_diffuser"))
  (if
    (not lay)                                                 ; Check to see correct layer exists
    (command "-layer" "n" "_diffuser" "c" "1" "_diffuser" "s" "_diffuser" ""); if not, create/set it
    (command "-layer" "s" "_diffuser" "")                          ; if it does, set it current
    )
  ;(command "_.layer" "Make" "_diffuser" "")
  (if
    (setq pt_int (getpoint "\nPick Insertion Point: "))
    (if
      (setq ang (getangle pt_int "\nAngle: "))
      (if
(setq size_h (getreal "\nHeight: "))
(if
  (setq size_w (getreal "\nWidth: "))
  (progn
    (setq pt_tmp (polar pt_int ang (/ size_h 2))
  pt_t1 (polar pt_tmp (+ ang (* pi 0.5)) (/ size_w 2))
  pt_t2 (polar pt_t1 (angle pt_tmp pt_int) size_h)
  pt_t3 (polar pt_t2 (angle pt_t1 pt_tmp) size_w)
  pt_t4 (polar pt_t3 (angle pt_int pt_tmp) size_h)
  )
    (command "_.LINE" pt_t1 pt_t2 pt_t3 pt_t4 "CLOSE")
    )
  )
)
      )
    ) 
  (princ)
  )


This will get you started.

Code: [Select]

(defun c:diffu (/ pt_int ang size_h size_w pt_tmp pt_t1 pt_t2 pt_t3
pt_t4)

  (command "_.layer" "Make" "_diffuser" "")

  (if (setq pt_int (getpoint "\nPick Insertion Point: "))
    (if (setq ang (getangle pt_int "\nAngle: "))
      (if (setq size_h (getreal "\nHeight: "))
(if (setq size_w (getreal "\nWidth: "))
  (progn
    (setq pt_tmp (polar pt_int ang (/ size_h 2))
  pt_t1 (polar pt_tmp (+ ang (* pi 0.5)) (/ size_w 2))
  pt_t2 (polar pt_t1 (angle pt_tmp pt_int) size_h)
  pt_t3 (polar pt_t2 (angle pt_t1 pt_tmp) size_w)
  pt_t4 (polar pt_t3 (angle pt_int pt_tmp) size_h)
    )
    (command "_.LINE" pt_t1 pt_t2 pt_t3 pt_t4 "CLOSE")
  )
)
      )
    )
  )

  (princ)
)

[Kerry]

 Not meaning to be antagonistic, but ..
 
Why change this :

Code: [Select]

;(command "_.layer" "Make" "_diffuser" "")
To This ??

Code: [Select]

(setq lay (tblsearch "layer" "_diffuser"))
  (if
    (not lay)                                                 ; Check to see correct layer exists
    (command "-layer" "n" "_diffuser" "c" "1" "_diffuser" "s" "_diffuser" ""); if not, create/set it
    (command "-layer" "s" "_diffuser" "")                          ; if it does, set it current
   )
.. and call it a correction ??

[Keith™]

I am with you Kerry ... I wouldn't call it a correction ... but ... it DOES clean up the command line output in the event the layer already exists ...

[Kerry]

The command line clutter can be fixed with setting CMDECHO to 0.

Mark <I believe> used the same procedure I would for test demo code.
The MAKE command for layer does just that .. makes it if not existing, and makes it current.

To my mind, the changes to Mark's code would be confusing to someone who is trying to grasp the fundamentals of Lisp.


A more productive addition would be a generic stand alone helper routine which could be passed the layer properties.

 

[Keith™]

The command line clutter can be fixed with setting CMDECHO to 0.

For the most part you are indeed correct, however this is not the way it works on some older versions of AutoCAD. An error is produced along the lines of "Layer already exists" and this output is unaffected by CMDECHO. I used to rewrite code many times that had this output, simply to rid the command line of unneeded output.

[Kerry]

Thats interesting Keith.

Which Version of Acad causes an error.

[Keith™]

I don't recall seeing that error in anything after 2002, but prior to that I had it quite regularly ... in one application I redesigned (it was R14 if my mind serves me correctly) the user created around 140 layers with a command ... sometimes the layers existed sometimes they did not, but everytime the command was used there would be output anywhere from 0 to 140 lines telling the user the layer already existed,  even though cmdecho was set to 0. Instead of checking for the existence of 140 layers, I finally decided it would be easier to simply create a blank drawing with all of the layer settings and insert it with the routine instead of create the layers programmatically, but then that was a unique situation ... I would typically use a lambda function to iterate through large numbers of layers, but alas, some people don't understand lambda and cringe whenever it is used (as was the project manager on this project)
Anyway, after some research, I don't think it is sonething that users would need to worry with if they are using a relatively new version of AutoCAD.

[Kerry]

I seem to recall R12 having the same "MAKE" functionality as the current version.

... anyway, you are correct that this probably isn't an issue.

To be practical ..
Attempting to Draw onto LOCKED Layers is probably a bigger issue ..

[CAB]

As Mark said his code was to get the user started toward his own code.
This too is a simple offering.

Code: [Select]

(defun c:diffu (/ usrcmd size_h size_w p1 bang bdiag layer_setup)

  (defun layer_setup (lyr Clr ltype)
    (if (tblsearch "LAYER" lyr)
      (command "._Layer" "_Thaw" lyr "_On" lyr "_UnLock" lyr "_Set" lyr "")
      (command "._Layer" "_Make" lyr "_Color" (if (= Clr "") "_White" Clr) lyr
              "LT" (if (= ltype "") "Continuous" ltype) lyr "")
    )
  )

  (setq usrcmd (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (layer_setup "_diffuser" "1" "")

  (if (and
        (setq size_h (getdist "\nHeight: "))
        (setq size_w (getdist "\nWidth: "))
      )
    (progn
      (setq p1    (getvar "viewctr")
            bang  (atan size_h size_w)
            bdiag (* (/ 1 (cos bang)) size_w)
      )
      (command "_.rectangle" p1 (polar p1 bang bdiag))
      (prompt "\nPick Insertion Point: ")
      (command "._move" (entlast) "" p1 pause)
      (prompt "\nPick Angle: ")
      (command "._rotate" (entlast) "" (getvar "lastpoint") pause)
    )
  )
  (setvar "cmdecho" usrcmd)
  (princ)
)
(prompt "\nDiffuser Loaded, Enter diffu to run.")
(princ)

[Andrea]

I am looking for a lisp routine that will let me insert a diffuser/grille to the size I specifie, like an 8x6, 12x8 etc. plus create a layer name. Any help email me gab@sweng.com. Thanks alot

Hi,

I have created many standards for many HVAC engineering firms and contractors
with all my experience in this field. I suggest you this..


If you have a layer standard in your company.
make a block containing a diffuser with 1 unit "X" by 1 unit "Y"
this block must be created NOT IN LAYER "0"...
create this block on layer "-Diffusers" color "ByBlock" Linetype "Byblock"
and call it "D1".

let me explain...

ALL HVAC design with reflected ceiling must be coordinated with
lightning, sprinkler, speaker and all other stuff in reflected ceiling right ?

so if you have a drawing with an Xref containing the reflected ceiling...
and you have also the lighting in Xref....from your workmate to make good coordination...

you can insert your diffuser block "D1" in your curren layer...eg:
if you are in layer "M-VENT-N"  (Mechanical VENTilation New)
your diffuser will be in the same layer but have created the "-diffusers" Layer
over the layer "0".

this will allow you to have the complete reflected ceiling with all your diffuser
by putting your current layer to "OFF". (M-VENT-N).

this is s simple way to insert your diffuser without changing layer or create another.

Also why put the "-" before the name ??
this is also a simple way to detect some block layer and goes all over the "0" layer list.

If you need to calculate the number of diffusers...I suggest you also to not explode the block.
but make sure to insert the good block...
eg:

eggcrate, EH_Price_Model or Titus_model and so on...
this will be more simple to claculate how many diffuser of each you need for your project.


this is was my suggestion.

[Royalchill]

good discussion. there was guy on the augi site nammed fatty from russia who wrote this. works greate. Thanks all

Code: [Select]

;===================================================================;

(defun coords-from-center (ptc xscl yscl /  len  wid )
  (setq len (* 0.5 xscl)
        wid (* 0.5 yscl)
ptc (trans ptc 1 0)
        p1 (list (- (car ptc) len)(- (cadr ptc) wid)(caddr ptc))
        p3 (list (+ (car ptc) len)(+ (cadr ptc) wid)(caddr ptc))
        p2 (list (car p3)(cadr p1)(caddr ptc))
        p4 (list (car p1)(cadr p3)(caddr ptc)))
        (list p1 p2 p3 p4))

;===================================================================;

(defun C:dff (/ *error* call ccr clr dfc-err info ipt
       olderr opw osm p1 p2 p3 p4 xscl yscl)

(setq olderr *error*
*error* dfc-err)
(setvar "cmdecho" 0)
(command "._undo" "_g") 
(setq osm (getvar "osmode")) 
(setq opw (getvar "plinewid"))
(setq clr (getvar "clayer"))
(setq ccr (getvar "cecolor")) 
(setvar "plinewid" 0.0)
(setvar "osmode" 0) 
 
  (defun layer_set (lyr col ltp)
  (if (tblsearch "layer" lyr)
  (command "._-layer" "t" lyr "u" lyr "on" lyr  "s" lyr "")
  (command "._-layer" "row" lyr "c" col lyr "lt" ltp lyr "")))

  (layer_set "m-diff" "3" "Continuous")
 
;;==============================================================================;;
 
(while (or   
(initget "Supply Return Exhaust")
(setq call (getkword "\n\tChoose the diffuser > Supply, Return or Exhaust :")))

(if call
(progn
(setq xscl (getreal "\n\tX dimension < 1.0 > ?? :\n"))
(if (not xscl)(setq xscl 1.))

(setq yscl (getreal "\n\tY dimension < 1.0 > ?? :\n"))
(if (not yscl)(setq yscl 1.))

(setvar "osmode" 32)
(initget 1)
(setq ipt (getpoint "\n\tInsertion point :\n"))

(setq info (coords-from-center ipt xscl yscl))

(setq p1 (car info)
      p2 (cadr info)
      p3 (caddr info)
      p4 (last info))


(setvar "clayer" "m-diff")
(setvar "cecolor" "bylayer")
(cond ((eq call "Supply")
       (command "._pline")
       (mapcar 'command (list p1 p4 p3 p1 p2 p4 p3 p2))(command ""))
      ((eq call "Return")
       (command "._pline")
       (mapcar 'command (list p1 p2 p3 p1 p4 p3))(command ""))
      ((eq call "Exhaust")
       (command "._pline")
       (mapcar 'command (list p1 p4 p3 p1 p2 ipt p3 p2))(command "")))
)))
(command "._undo" "_e") 
(setvar "plinewid" opw) 
(setvar "osmode" osm)
(setvar "clayer" clr)
(setvar "cecolor" ccr) 
(setvar "cmdecho" 1)
(setq *error* olderr) 
(princ)
)

(defun dfc-err  (s)
  (princ (strcat "\nError: " s))
  (command "._undo" "_e")
  (setvar "cmdecho" 1)
  (setvar "plinewid" opw) 
  (setvar "osmode" osm)
  (setvar "clayer" clr)
  (setvar "cecolor" ccr)
  (setq *error* olderr)
  (princ))

(prompt "\n\t***\tType DFC to execute...\t***\n")
(princ)
;=======================================================================;

Edit - CAB added code tags.