;; ******************************************************************************
;; Determine centroid of a polygon
;;
;; Algorithm:
;; 1. Form trapezoids by dropping lines from each segment to a basey axis.
;; 2. Calculate the area and CG of the triangle and rectangle in each trapezoid
;; 3. Sums up weighted moments against given axes in X and Y direction
;; (may use x and y axes if number is small)
;; 4. Derived CG by dividing weighted sum by total area.
;; ******************************************************************************
(defun GE_centroid(vlist / segno n ttl_area basex basey p1 p2 x1 x2 y1 y2
t_x t_y t_area t_xm t_ym r_x r_y r_area r_xm r_ym Mx My)
(setq
vlist (append vlist (list (car vlist)))
segno (1- (length vlist)) ; no of segments
n 0
Ttl_Area 0.0 ; total area
Mx 0.0 ; Sum of moment to basex line
My 0.0 ; Sum of moment to basey line
basex (car (nth 0 vlist)) ; arbitrary axes (will reduce error for large numbers)
basey (cadr (nth 0 vlist))
)
(repeat segno
(setq
p1 (nth n vlist) ; process current segment
p2 (nth (1+ n) vlist)
x1 (car p1)
y1 (cadr p1)
x2 (car p2)
y2 (cadr p2)
; For the triangle
t_x (- (* (+ x2 x2 x1) 0.333333) basex) ; cg of trianlge
t_y (- (* (+ y1 y1 y2) 0.333333) basey)
t_area (* (- y2 y1) (- x2 x1) 0.5) ; area of triangle
t_xm (* t_area t_x) ; moment to Basex
t_ym (* t_area t_y) ; moment to basey
; For the rectangle
r_x (- (/ (+ x1 x2) 2) basex) ; CG of rectangle
r_y (- (/ (+ basey y1) 2) basey)
r_area (* (- x2 x1) (- y1 basey)) ; area of rectangle
r_xm (* r_area r_x) ; moment to basex
r_ym (* r_area r_y) ; moment to basey
Ttl_Area (+ Ttl_Area t_area r_area)
Mx (+ Mx t_xm r_xm) ; adds up moments to basex
My (+ My t_ym r_ym) ; adds up moments to basey
n (1+ n)
)
)
(list (+ (/ Mx Ttl_Area) basex) (+ (/ My Ttl_Area) basey))
)
MSTG007,
I would like to know after I load centroid.lsp, what command to execute? Currently it comes back with EEA-CENTROID-SOLID-LW after loaded but looking at lisp, it says (defun c:pc...
I want it to return with pc to start lisp.
Thank you,
David
Thank you very much for your response. I put (princ) at the end and that worked. What I'm asking is that after I load centroid.lsp that it returns with c:PC to let me know what invokes it.
(princ "\nType 'PC' to invoke the program.")
(princ)(princ "\nType 'PC' to invoke the program.")
(alert "Type 'PC' to invoke the program.\n\nDont forget abot the other options\nA or B\n Folowed by C")
(alert "\n The program command is TEST, the specific usage is as follows:
\n unit and precision are determined by ACAD, you can control it yourself, select closed line segment objects, or region objects,
\n When prompted for data output mode, press P or W key, P stands for screen output, and W creates data on C: drive.
\nPlease respect the original, not for commercial purposes!! Highflybird 2007.1.23 KunMing")
(defun mas (obj / Area Area1 Area2 Perimeter Centroid Centroid1 Centroid2 MomentOfInertia
MomentOfInertia1 PrincipalDirections PrincipalMoments minpt maxpt Sx Sy
ProductOfInertia ProductOfInertia1 RadiiOfGyration Wx1 Wx2 Wy1 Wy2 obj1
Obj2 recPt1 recPt2 reg1 reg2 CenX CenY)
(if (= "AcDbRegion" (vla-get-objectname obj)) ; if it is a section, then calculate
(progn
(setq Area (vla-get-area obj); area
Perimeter (vla-get-Perimeter obj) ; perimeter
Centroid (V2L (vla-get-Centroid obj)); centroid
MomentOfInertia (V2L (vla-get-MomentOfInertia obj)); moment of inertia
PrincipalDirections (V2L (vla-get-PrincipalDirections obj)); direction of the principal moment
PrincipalMoments (V2L (vla-get-PrincipalMoments obj)); the principal moment and the X-Y direction of the centroid
ProductOfInertia (vla-get-ProductOfInertia obj) ; inertia product
); setq
(vla-move obj (vlax-3d-point Centroid) (vlax-3d-point '(0 0))); moving the centroid to the origin
(setq MomentOfInertia1 (V2L (vla-get-MomentOfInertia obj)); centroid moment of inertia
ProductOfInertia1 (vla-get-ProductOfInertia obj) ; the inertia product of the centroid
RadiiOfGyration (V2L (vla-get-RadiiOfGyration obj)); radius of gyration
); setq
(vla-getboundingbox obj 'minpt 'maxpt) ; bounding box
(setq minpt (vlax-safearray->list minpt) ; bottom left corner
Maxpt (vlax-safearray->list maxpt) ; top right corner
Wx1 (/ (car MomentOfInertia1) (cadr minpt)); resistance moment
Wx2 (/ (car MomentOfInertia1) (cadr maxpt))
Wy1 (/ (cadr MomentOfInertia1) (car minpt))
Wy2 (/ (cadr MomentOfInertia1) (car maxpt))
); setq
(vla-move obj (vlax-3d-point '(0 0)) (vlax-3d-point Centroid)) ; moved back to its original location
(setq obj1 (vla-copy obj) ; copy the object to calculate the X area moment
Obj2 (vla-copy obj) ; copy the object to calculate the Y area moment
CenX (car Centroid)
CenY (cadr Centroid)
recPt1 (list (+ CenX (car minpt) -1) CenY ; create a point table for two rectangular regions
(+ CenX (car maxpt) +1) CenY
(+ CenX (car maxpt) +1) (+ CenY (cadr minpt) -1)
(+ CenX (car minpt) -1) (+ CenY (cadr minpt) -1))
recPt2 (list (+ CenX (car minpt) -1) (+ CenY (cadr minpt) -1)
(+ CenX (car minpt) -1) (+ CenY (cadr maxpt) +1)
CenX (+ CenY (cadr maxpt) +1)
CenX (+ CenY (cadr minpt) -1))
Reg1 (draw-rectange recPt1) ; create area 1
Reg2 (draw-rectange recPt2) ; create area 2
)
(vla-boolean obj1 acSubtraction reg1) ; find the difference between obj1 and area 1
(vla-boolean obj2 acSubtraction reg2) ; find the difference between obj2 and area 2
(setq Area1 (vla-get-area obj1) ; find the area of obj1
Area2 (vla-get-area obj2) ; seek area of obj2
Centroid1 (V2L (vla-get-Centroid obj1)); seeking the centroid of obj1
Centroid2 (V2L (vla-get-Centroid obj2)); seeking the centroid of obj2
Sx (* Area1 (- (cadr Centroid1) (cadr Centroid))); around the X-axis area moment (static moment)
Sy (* Area2 (- (car Centroid2) (car Centroid))); area around the Y axis (static moment)
)
(vla-delete obj1) ; delete area 1
(vla-delete obj2) ; delete area 2
(list (cons "area" Area); returns various parameter values
(cons "perimeter" Perimeter)
(cons "centroid" Centroid)
(cons "X Principal Moment" (car PrincipalMoments)
(cons "X-axis moment of inertia" (car MomentOfInertia1))
(cons "Y axis main moment of inertia" (cadr PrincipalMoments)
(cons "Y-axis moment of inertia" (cadr MomentOfInertia1))
(cons "XY Inertia Product" ProductOfInertia1)
(cons "bending resistance on the X axis" Wx2)
(cons "X-axis bending resistance" (Wx1)
(cons "Y axis left bending distance" Wy1)
(cons "Y axis right bending resistance" Wy2)
(cons "X-axis area moment" Sx )
(cons "Y axis area moment" Sy )
(cons "swirl radius ix" (car RadiiOfGyration))
(cons "swirl radius iy" (cadr RadiiOfGyration))
(cons "car PrincipalDirections" (caddr PrincipalDirections)))
(cons "cadr PrincipalDirections" (cadddr PrincipalDirections)))
(cons "distance from the left" (abs (car minpt)))
(cons "distance from the right" (abs (car maxpt)))
(cons "distance from the top" (abs (cadr maxpt)))
(cons "distance from the bottom" (abs (cadr minpt)))
)
)
)
)
;;;Draw a rectangular area with ActiveX
(defun draw-rectange (recpts / pts rec reg)
(setq pts (vlax-make-safearray vlax-vbdouble '(0. 7)))
(vlax-safearray-fill pts recpts)
(setq rec (vla-addlightweightPolyline *MSP pts)); create a rectangle
(vla-put-closed rec 1) ; closed rectangle
(setq reg (vla-addregion *MSP (O2L rec)));
(vla-delete rec) - delete the light polyline of the rectangle
(car (V2L reg))
;;;ActiveX variables are converted to lisp list
(defun V2L (x)
(vlax-safearray->list (vlax-variant-value x))
)
;;; convert the object of the selection set into a safe array
(defun S2A (ss / i l objs curves)
(setq i -1 l (sslength ss) objs nil)
(repeat l
(setq objs (cons (vlax-ename->vla-object (ssname ss (setq i (1+ i)))) objs))
)
(setq curves (vlax-make-safearray vlax-vbobject (eval '(cons 0 (1- l)))))
(vlax-safearray-fill curves objs)
)
;;; convert the object of the selection set to a Lisp table
(defun S2L (ss / i l objs)
(setq i -1 l (sslength ss) objs nil)
(repeat l
(setq objs (cons (vlax-ename->vla-object (ssname ss (setq i (1+ i)))) objs))
)
)
;;; object composition lisp list
(defun O2L (obj / curves)
(setq curves (vlax-make-safearray vlax-vbobject '(0 . 0)))
(vlax-safearray-fill curves (list obj))
)
;;; print the section table and count
(defun GetNum (regobjs Num / Number reglst)
(setq Number Num) ; count to zero
(foreach obj regobjs
(setq reglst (mas obj)) ; evaluate it separately
(princ obj) ; print the region name
(princ "\n below is a list of parameters for this object: ")
(foreach n reglst (princ "\n") (princ n)) ; print region parameter table
(setq Number (1+ Number)); count accumulate
)
)
;;;table converted to a string
(defun L2S (lst / s)
(setq s
(apply
'strcat
(mapcar '(lambda(x)(strcat (rtos x) " ")) lst)
)
)
(setq s (substr s 1 (1- (strlen s))))
(strcat "(" s ")")
)
;;;write data function
(defun WrData (regobjs Num / Number reglst string str1 str2 str)
(setq Number Num) ; count to zero
(foreach obj regobjs
(setq reglst (mas obj)) ; evaluate it separately
(setq Number (1+ Number)); count accumulate
(write-line "***********************************" file)
(setq string (strcat "section" (itoa Number)" parameter list: "))
(write-line string file) ; write the region name
(foreach n reglst
(setq str1 (car n)) ; parameter name
(if (listp (setq str2 (cdr n))); parameter value
(setq str2 (L2S str2))
(setq str2 (rtos str2))
)
(setq str (strcat str1 ": " str2))
(write-line str file) ; write region parameter table
)
)
Number
)
;;;The following test procedure
(defun C:test (/ *APP *DOC *MSP i j ss ss1 err objlst REGs W&P OLDCMD OldUcs file)
(vl-load-com)
(setq *APP (vlax-get-acad-object)
*DOC (vla-get-activeDocument *APP)
*MSP (vla-get-Modelspace *DOC)
)
(princ)
(if (setq ss (ssget)) ; establish a selection set
(progn
(initget 1 "W P") ; choose to write to file or screen print
(setq W&P (getkword "\n determine the output data mode: \n write file [W] or screen print [P])?"))
(princ "\n")
(setq OLDCMD (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
;;(command ".UCS" "W")
(uu 1)
(setq objlst (S2A ss)) ; selection set list
(if (setq ss1 (ssget "P" '((0 . "REGION"))))); select the existing region in the set
(setq i (if (= W&P "P") ; calculate and find the number of regions
(GetNum (S2L ss1) 0)
(progn
(setq file (open "C:\\section geometry parameter.TXT""W")); open file
(Wrdata (S2L ss1) 0)
)
)
)
(setq i 0)
)
(defun addreg ()
(setq REGs (vla-addregion *MSP objlst))
)
(setq err (vl-catch-all-apply 'addreg)) ; create area and error detection
(if (vl-catch-all-error-p err) ; if no new region is created
(setq j 0) ; then the count is 0
(setq REGs (V2L REGs) ; otherwise converted to region collection
i (if (= W&P "P") ; calculate and find the number of regions
(GetNum REGs i)
(progn
(setq file (open "C:\\section geometry parameter.TXT""A")); open file
(Wrdata REGs i)
)
)
j (mapcar 'vla-delete REGs) ; delete the newly created section
)
)
(close file) ; close the file
(if (/= 0 i)
(progn
(princ "\n\n is already listed")
(princ i)
(princ "section geometry table.")
)
(alert "The valid section is not selected!")
)
;;(command ".UCS" "P")
(uu 0)
(setvar "CMDECHO" OLDCMD)
)
(alert "You have no objects selected!")
)
(gc)
(princ)
)
(defun uu (T&F / WCSOrg WCSXDr WCSYDr WCSObj OldOrg OldXDr OldYDr *UTI *UCS)
(setq *UTI (vla-get-Utility *DOC) ; Get the Utility set
*UCS (vla-get-UserCoordinateSystems *DOC); get UCS set
)
(setq WCSOrg (vlax-3d-point '(0 0 0))); WCS origin
(setq WCSXDr (vlax-3d-point '(1 0 0)))
(setq WCSYDr (vlax-3d-point '(0 1 0)))
(setq WCSObj (vla-add *UCS WCSOrg WCSXDr WCSYDr "WCS"))
(if (= T&F 1)
(progn
(if (= (getvar "UCSNAME") "") ; the current UCS name, if not named, then
(progn
(setq OldOrg (vla-GetVariable *DOC "UCSORG") ; take the current UCS origin
OldXDr (vla-getVariable *DOC "UCSXDIR") ; take the current X direction
OldYDr (vla-getVariable *DOC "UCSYDIR") ; take the current Y direction
OldUcs (vla-add *UCS WCSOrg OldXDr OldYDr "OLD"); establish the current UCS, but the origin is at '(0,0,0)
)
(vla-put-origin OldUcs OldOrg) ; change the origin to the current UCS origin
)
(setq OldUcs (vla-get-ActiveUcs *DOC)) ; if named, get UCS object
)
(vla-put-ActiveUcs *DOC WCSobj)
)
(vla-put-ActiveUcs *DOC OldUcs)
)
OldUcs
)