Re: Section Properties

Thanks Dave I will take into work on Monday and give it a go.....

Regards

Alan


On Fri, 02 Sep 2005 09:51:51 -0700, long&left <nospam@xxxxxxxxxxxxxxx>
wrote:

>cadalot wrote:
>> Hi Guys
>>
>> I'm looking for a lisp routine or program that will give me the
>> section properties of a drawn object.
>>
>> The object on question is an office block and I'm looking the the
>> properties Area, I & Z in two directions say x-x and y-y.of the shear
>> walls for wind resistance, so that I can do a W/A +_ M/Z Calculation
>>
>> Normally I would calculate from first principals, however in this case
>> the Architect has left little square or parallel on the scheme. Plus
>> I'm pressed for time, and the building is morphing all the tiime.
>>
>> Many of the links I had for souces of Freeware & Shareware lisp
>> routines seem to be off line or no longer exist!
>>
>> Any suggestions ?
>>
>> Regards
>>
>> Alan
>
>hopefully this is what you need...be sure to check for word wrapping!
>This was not written by me and I take no responsibility for it's
>accuracy but I've been using it for 5 or 6 years without any problems
>Dave
>DDP
>
>(defun C:SP (/ cecho oldlay ss E sslen selset cecho cnt oldlay
> Xcentr Ycentr area 1momx 1momy 2momx 2momy
> minx miny maxx maxy startx endx xbar ybar
> dx dA d1momx d2momx d1momy d2momy dPxy Pxy
> Ix Iy Imax Imin Ibig rx ry rz J cx1 cx2 cy1 cy2
> rot rotlin ang radical center extens extens
> hatchsc selset rot rotlin newdy dy)
> (setq cecho (getvar "cmdecho")
> oldlay (getvar "clayer")
> selset (ssget)
> dy 0.1)
> (setvar "cmdecho" 0)
>
>; ********************************
>; ***** Initialize Variables *****
>; ********************************
>
> (progn
> (setq cnt 0 area 0 Xcentr 0 Ycentr 0
> 1momx 0 1momy 0 2momx 0 2momy 0 Pxy 0
> minx 0 maxx 0 miny 0 maxy 0
> oldlay (GETVAR "CLAYER") )
> (terpri)
> (setq newdy (getreal (strcat "Larger hatch spacing for speed/"
> "smaller spacing for accuracy"
> "\nSET Hatch Spacing NOW <"(rtos (/ dy 10)) ">: ")))
> (if (> newdy 0)
> (setq dy (* newdy 10)))
> (setq dy (* dy 0.1)
> hatchsc (* dy 8))
>
>; *********************************************
>; ***** Make working layers & hatch shape *****
>; *********************************************
>
> (command "LAYER" "N" "Hatching" "C" "YELLOW" "hatching"
> "N" "Centroid" "C" "GREEN" "centroid"
> "M" "Tmphatch" "C" "YELLOW" "tmphatch" ""
> "HATCH" "*LINE" hatchsc "0" selset ""
> "LAYER" "OFF" "*" "N" "")
> (setq SS (ssget "W" (GETVAR "extmax") (GETVAR "extmin"))
> sslen (sslength SS)
> E (entget (ssname SS cnt))
> minx (cadr (assoc 10 E))
> maxx (cadr (assoc 11 E))
> miny (caddr (assoc 10 E))
> maxy (caddr (assoc 11 E)))
>
>; *********************************
>; ***** Numerical Integration *****
>; *********************************
>
> (while (< cnt (- sslen 1))
> (progn
> (setq E (entget (ssname SS cnt))
> startx (CADR (ASSOC 10 E))
> endx (CADR (ASSOC 11 E))
> xbar (/ (+ startx endx) 2)
> ybar (CADDR (ASSOC 10 E)))
> (if (< startx minx ) (setq minx startx))
> (if (< endx minx ) (setq minx endx))
> (if (> startx maxx ) (setq maxx startx))
> (if (> endx maxx ) (setq maxx endx))
> (if (< ybar miny ) (setq miny ybar))
> (if (> ybar maxy ) (setq maxy ybar))
> (setq dx (ABS (- startx endx))
> dA (* dx dy)
> d1momx (* ybar dA)
> d1momy (* xbar dA)
> d2momx (+ (/ (* (expt dy 2) dA) 12) (* ybar d1momx))
> d2momy (+ (/ (* (expt dx 2) dA) 12) (* xbar d1momy))
> AREA (+ AREA dA)
> 1momx (+ 1momx d1momx)
> 1momy (+ 1momy d1momy)
> 2momx (+ 2momx d2momx)
> 2momy (+ 2momy d2momy)
> dPxy (* xbar (* dx (* ybar dy)))
> Pxy (+ Pxy dPxy)
> cnt (+ cnt 1))
> );progn
> );while
>
>; *******************************************
>; ***** Calculate Sectional Properties *****
>; *******************************************
>
> (setq Xcentr (/ 1momy Area)
> Ycentr (/ 1momx Area)
> Ix (- 2momx (* area (* Ycentr Ycentr)))
> Iy (- 2momy (* area (* Xcentr Xcentr)))
> rx (sqrt (/ Ix area))
> ry (sqrt (/ Iy area))
> J (+ Ix Iy)
> cx1 (- maxx Xcentr)
> cx2 (- Xcentr minx)
> cy1 (- maxy Ycentr)
> cy2 (- Ycentr miny)
> Pxy (- Pxy (* (* Xcentr Ycentr) area))
> Ibig (if (> Ix Iy) Ix Iy))
> (if (> (abs Pxy) (/ Ibig 1000)); unsymmetrical shapes
> (progn
> (if (> Ix Iy)
> (setq ang (+ (* (/ (angle (list 0 0) (list (- Ix Iy)
> (* Pxy -2))) 2) (/ 180 pi)) 180))
> (setq ang (+ (* (/ (angle (list 0 0) (list (- Ix Iy)
> (* Pxy -2))) 2) (/ 180 pi)) 270))
> );if
> (setq radical (sqrt (+ (/ (expt (- Ix Iy) 2) 4) (* Pxy Pxy)))
> center (/ (+ Ix Iy) 2)
> Imax (+ center radical)
> Imin (- center radical)
> rz (sqrt (/ Imin area)))
> ); progn statement
> ); if statement
>
>; **********************************************
>; ***** Add Graphics - Hatch, axes, text *****
>; **********************************************
>
> (setq hatchsc (* (getvar "textsize") 3)
> extens (* (- maxy miny) 0.1)
> extens2 (+ (* (- maxy miny) 0.1) (getvar "textsize")))
> (command "ERASE" "W" (GETVAR "extmax") (GETVAR "extmin") ""
> "LAYER" "S" "hatching" "ON" "*" ""
> "SELECT" selset ""
> "HATCH" "LINE" hatchsc "0" "P" ""
> "LAYER" "S" "centroid" ""
> "TEXT" "J" "M" (LIST (- minx extens2) Ycentr)
> "" "" "X"
> "TEXT" "J" "M" (LIST (+ maxx extens2) Ycentr)
> "" "" "X"
> "TEXT" "J" "M" (LIST Xcentr (- miny extens2))
> "" "" "Y"
> "TEXT" "J" "M" (LIST Xcentr (+ maxy extens2))
> "" "" "Y")
> (if (> (abs Pxy) (/ Ibig 1000))
> (if (> Ix Iy); add axis for Imax, Imin
> (progn
> (command "TEXT" "J" "M" (LIST Xcentr (- miny extens2))
> "" "" "Z")
> (setq rot (ssadd))
> (ssadd (entlast) rot)
> (command "TEXT" "J" "M" (LIST Xcentr (+ maxy extens2))
> "" "" "Z")
> (ssadd (entlast) rot)
> ); progn
> (progn
> (command "TEXT" "J" "M" (LIST (- minx extens2) Ycentr)
> "" "" "Z")
> (setq rot (ssadd))
> (ssadd (entlast) rot)
> (command "TEXT" "J" "M" (LIST (+ maxx extens2) Ycentr)
> "" "" "Z")
> (ssadd (entlast) rot)
> );progn
> );if
> );if
> (command "LINE" (LIST (- minx extens) Ycentr)
> (LIST (+ maxx extens) Ycentr) "")
> (setq rotlin (ssadd))
> (ssadd (entlast) rotlin)
> (command "LINE" (LIST Xcentr (- miny extens))
> (LIST Xcentr (+ maxy extens)) ""
> "LAYER" "S" oldlay "")
> (ssadd (entlast) rotlin)
>
>; ****************************************
>; ***** Print Properties to Drawing *****
>; ****************************************
>
> (command "TEXT" (LIST (- minx extens2) (- (- miny extens2)
> (* 2 (getvar "textsize"))))
> "" "" "%%uX-Y Axes: "
> "TEXT" "" (strcat " AREA = " (rtos AREA))
> "TEXT" "" (strcat " Ixx = " (rtos Ix))
> "TEXT" "" (strcat " Iyy = " (rtos Iy))
> "TEXT" "" (strcat " cx1 = " (rtos cx1))
> );command
> (if (> (abs (/ (- cx2 cx1) cx1)) 0.001)
> (command "TEXT" "" (strcat " cx2 = " (rtos cx2))))
> (command "TEXT" "" (strcat " cy1 = " (rtos cy1)))
> (if (> (abs (/ (- cy2 cy1) cy1)) 0.001)
> (command "TEXT" "" (strcat " cy2 = " (rtos cy2))))
> (if (> (abs Pxy) (/ Ibig 1000))
> (command "TEXT" "" (strcat " Ixy = " (rtos Pxy))))
> (command "TEXT" "" (strcat " rx = " (rtos rx))
> "TEXT" "" (strcat " ry = " (rtos ry))
> "TEXT" "" (strcat " J = " (rtos J)))
> (if (> (abs Pxy) (/ Ibig 1000))
> (progn
> (command "TEXT" "" "%%UPrincipal Axes: "
> "TEXT" "" (strcat " Imax = " (rtos Imax))
> "TEXT" "" (strcat " Izz(min) = " (rtos Imin))
> "TEXT" "" (strcat " rz(min) = " (rtos rz))
> "TEXT" "" (strcat " Axis rotation = " (rtos (- 360
>ang)))
> "COPY" rotlin "" "0,0" "0,0"
> "ROTATE" rotlin rot "" (LIST Xcentr Ycentr) ang)
> ); progn statement
> ); if statement
>
>; ****************************************
>; ***** Print Properties to Screen *****
>; ****************************************
>
>; (terpri)
>; (princ " ***** SECTIONAL PROPERTIES *****")
>; (terpri)
>; (princ "X-Y Axes: AREA = ")(princ AREA)(princ" ")
>; (princ "Ixx = ")(princ Ix)(princ " ")
>; (princ "Iyy = ")(princ Iy)(princ " ")
>; (if (> (abs Pxy) (/ Ibig 1000))
>; (progn (princ "Ixy = ")(princ Pxy)))
>; (terpri)
>; (princ " rx = ")(princ rx)(princ " ")
>; (princ "ry = ")(princ ry)(princ " ")
>; (princ "J = ")(princ J)
>; (terpri)
>; (if (> (abs Pxy) (/ Ibig 1000))
>; (progn
>; (princ "Princ Axes: ")
>; (princ "Imax = ")(princ Imax)(princ " ")
>; (princ "Izz(min) = ")(princ Imin)(princ " ")
>; (princ "rz(min) = ")(princ rz)(princ " ")
>; ); progn statement
>; ); if statement
>
> (command "SELECT" selset ""
> "REDRAW")
> (princ)
> ); progn statement
>); defun statement
.

Relevant Pages

  • Re: BizTalk 2004 Books?
    ... Current availability date is on or close to November 1st. ... > Hi Dave, ...
    (microsoft.public.biztalk.general)
  • Re: Trip Report - Gentlemens Assateague Trip 2004 (long)
    ... Dave Hone, JD, Ben Palmer, Alan Reid ... >The stated purpose of this year's Gentlemen's Trip was to test paddle ... >all of his camping and paddling gear. ...
    (rec.boats.paddle)
  • Re: Amus To Be Back
    ... contract to do. ... Go ahead and slink off with your tail between your legs, Alan. ... Dave, we seem to have hit a nerve with the Gang of Four. ... anything that politically correct Gang of Four can lay claim to. ...
    (soc.senior.issues)
  • Re: Amus To Be Back
    ... contract to do. ... Isn't it wonderful when the politically correct ideologues get ... Go ahead and slink off with your tail between your legs, Alan. ... Dave, we seem to have hit a nerve with the Gang of Four. ...
    (soc.senior.issues)
  • Re: Ron de Bruins copy5 code amendment
    ... exhausted what brains I have. ... > Hi Ron, ... >> regards, Alan ...
    (microsoft.public.excel.programming)