Section Properties

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

 

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

Regards

Alan