Lisp to find Center of Gravity

Is there a lisp to get the Center of Gravity for an area

and if it is possible getting the CG for several areas

I am thinking that, that lisp draws a point in CG and a leader showing the coordinates (or what ever) for pointing to the CG

as attached

Thanx

Just a footnote the centre of a hatch pattern is not the centre of gravity for the 3 objects shown.

If you extrude the objects and subtract the holes then list object you will get the true centre of gravity. this works for concrete tilt panels not sure how then to get centre gravity of 3 panels combined. 1st principles maybe for centroid.

Just a footnote the centre of a hatch pattern is not the centre of gravity for the 3 objects shown.

 

If you extrude the objects and subtract the holes then list object you will get the true centre of gravity. this works for concrete tilt panels not sure how then to get centre gravity of 3 panels combined. 1st principles maybe for centroid.

Hi, BIGAL

Yes, you're right

I deleted my worng solution

~'J'~

thanx fixo

thanx BIGAL

that what I doing but

I am searching for a lisp for saving the time for extrude of each area

but i cant get the CG for more than one area, in that case i have to use another program looks like SAP or what ever

I want to do every thing in AutoCAD

Thans all

I wrote a program to place a point on the centroid of a solid or region, it may help

CENT

http://www.resourcecad.com/programs/

If I remember correctly, if you select more than one solid or region then use MASSPROPS, the centroid it returns is the centroid of all the objects

Draws circles in Centroid points:

(defun c:gecen(/ cSet cLst oldSnp)
 (vl-load-com)
 (princ "\n<<<Select Regions or 3D-solids >>> ")
 (if(setq cSet(ssget '((0 . "REGION,3DSOLID"))))
   (progn
     (setq cLst(mapcar 'vlax-ename->vla-object
                      (vl-remove-if 'listp
                        (mapcar 'cadr(ssnamex cSet))))
    oldSnp(getvar "OSMODE")
    ); end setq
     (mapcar 'setvar (list "OSMODE" "CMDECHO")(list 0 0))
     (foreach ent cLst
(if(vlax-property-available-p ent 'Centroid)
            (command "_.circle"(vlax-get ent 'Centroid)"50.0")
  ); end if
); end foreach
     (mapcar 'setvar (list "OSMODE" "CMDECHO")(list oldSnp 1))
     ); end progn
   ); end if
 (princ)
 ); end of c:gecen

Thanx ASMI

that lisp is very good

Could that lisp get one CG for the selected objects

Regards

Ok.

(defun c:gecen(/ cSet cLst oldSnp cCen cAre cmLst gCen)
 
 (vl-load-com)
 
 (princ "\n<<<Select Regions or 3D-solids >>> ")
 (if(setq cSet(ssget '((0 . "REGION,3DSOLID"))))
   (progn
     (setq cLst(mapcar 'vlax-ename->vla-object
                      (vl-remove-if 'listp
                        (mapcar 'cadr(ssnamex cSet))))
    oldSnp(getvar "OSMODE")
    ); end setq
     (mapcar 'setvar (list "OSMODE" "CMDECHO")(list 0 0))
     (foreach ent cLst
(if(vlax-property-available-p ent 'Centroid)
  (progn
    (setq cCen(vlax-get ent 'Centroid)
	  cAre(vlax-get ent 'Area)
	  cmLst(cons(list cCen cAre)cmLst)
	  ); end setq
           (command "_.circle" cCen "50.0")
           ); end progn
  ); end if
); end foreach
   (if
     (and
cmLst
(/= 1(length cmLst))
); enad and
     (progn
(setq gCen
       (list
	 (/
	   (apply '+
	      (mapcar '*
		 (mapcar 'caar cmLst)(mapcar 'cadr cmLst)))
	   (apply '+ (mapcar 'cadr cmLst))
	   ); end /
	 (/
	   (apply '+
	      (mapcar '*
		 (mapcar 'cadar cmLst)(mapcar 'cadr cmLst)))
	   (apply '+ (mapcar 'cadr cmLst))
	   ); end /
	 ); end list
      ); end setq
(command "_.circle" gCen "50")
(foreach pt(mapcar 'car cmLst)
  (command "_.line" pt  gCen "")
  ); end foreach
); end progn
     ); end if
     (mapcar 'setvar (list "OSMODE" "CMDECHO")(list oldSnp 1))
     ); end progn
   ); end if
 (princ)
 ); end of c:gecen

I can add leaders with coordianates, but I dont't know text size you need. Or you want request for text size and circles diameter

what a great lisp

refer to the leader and text, can you use the current styles for dim and text.

refer to selecting objects, is it posible to select a pline? or click inside the area for avoiding any void in shape (looks like upper shape in attached pic)

thanx

Ok. Maybe tomorrow, today there isn't time.

Found a few time.

(defun c:gecen(/ actDoc cSet cLst oldSnp cCen cAre cmLst gCen enPt)
 
 (vl-load-com)
 
 (princ "\n<<<Select Regions or 3D-solids >>> ")
 (if(setq cSet(ssget '((0 . "REGION,3DSOLID"))))
   (progn
     (setq cLst(mapcar 'vlax-ename->vla-object
                      (vl-remove-if 'listp
                        (mapcar 'cadr(ssnamex cSet))))
    oldSnp(getvar "OSMODE")
    ); end setq
     (mapcar 'setvar (list "OSMODE" "CMDECHO")(list 0 0))
     (vla-StartUndoMark
(setq actDoc(vla-get-ActiveDocument
	      (vlax-get-acad-object))))
     (foreach ent cLst
(if(vlax-property-available-p ent 'Centroid)
  (progn
    (setq cCen(vlax-get ent 'Centroid)
	  cAre(vlax-get ent 'Area)
	  cmLst(cons(list cCen cAre)cmLst)
	  ); end setq
           ); end progn
  ); end if
); end foreach
   (if
     (and
cmLst
(/= 1(length cmLst))
); enad and
     (progn
(setq gCen
       (list
	 (/
	   (apply '+
	      (mapcar '*
		 (mapcar 'caar cmLst)(mapcar 'cadr cmLst)))
	   (apply '+ (mapcar 'cadr cmLst))
	   ); end /
	 (/
	   (apply '+
	      (mapcar '*
		 (mapcar 'cadar cmLst)(mapcar 'cadr cmLst)))
	   (apply '+ (mapcar 'cadr cmLst))
	   ); end /
	 ); end list
      enPt(polar gCen(/ pi 3)
		   (*(getvar "DIMTXT")(getvar "DIMSCALE")5))
      ); end setq
(command "_.qleader" gCen enPt "" "" "temp_text" "")
(vla-put-TextString
    (vlax-ename->vla-object(entlast))
    (strcat "x="(rtos(car gCen)2(getvar "DIMDEC"))
	    "\\P"
	    "y="(rtos(cadr gCen)2(getvar "DIMDEC"))
	    ); end strcat
    ); end vla-put-TextString
(foreach pt(mapcar 'car cmLst)
  (command "_.line" pt  gCen "")
  (setq enPt(polar pt(/ pi 3)
		   (*(getvar "DIMTXT")(getvar "DIMSCALE")5)))
  (command "_.qleader" pt enPt "" "" "temp_text" "")
  (vla-put-TextString
    (vlax-ename->vla-object(entlast))
    (strcat "x="(rtos(car pt)2 2)
	    "\\P"
	    "y="(rtos(cadr pt)2 2)
	    ); end strcat
    ); end vla-put-TextString
  ); end foreach
); end progn
     ); end if
     (mapcar 'setvar (list "OSMODE" "CMDECHO")(list oldSnp 1))
     (vla-EndUndoMark actDoc)
     ); end progn
   ); end if
 (princ)
 ); end of c:gecen

Is it good? Coordinates in the current UCS.

Thank ASMI

i tested it and work fine till now

This is great lisp

But can this lisp get the CG of this shape?

I love this script but it doesn't work with solids

I get this error back:

; error: ActiveX Server returned the error: unknown name: "AREA"

I don't know a lot (like nothing) of visuallisp, soooo any one who can fix this?

You can retrieve volumes from solids instead of area

Here is quick edition, not so elegant though

Not tested do it by yourself

(defun c:gec(/ actDoc cSet cLst oldSnp cCen cAre cmcList cmvList gCen enPt)

 (vl-load-com)

 (princ "\n<<<Select Regions or 3D-solids >>> ")
 (if(setq cSet(ssget '((0 . "REGION,3DSOLID"))))
   (progn
     (setq cLst(mapcar 'vlax-ename->vla-object
                      (vl-remove-if 'listp
                        (mapcar 'cadr(ssnamex cSet))))
    oldSnp(getvar "OSMODE")
    ); end setq
     (mapcar 'setvar (list "OSMODE" "CMDECHO")(list 0 0))
     (vla-StartUndoMark
(setq actDoc(vla-get-ActiveDocument
       (vlax-get-acad-object))))

     (foreach obj cLst
(if (vlax-property-available-p obj 'Centroid)
  (cond ((eq "AcDbRegion" (vla-get-objectname obj))
  (progn
    (setq cCen(vlax-get obj 'Centroid)
   cAre(vlax-get obj 'Area)
   cmcList(cons(list cCen cAre)cmcList)
   ); end setq
           ); end progn
  )
 ((eq "AcDb3dSolid" (vla-get-objectname obj))
  (progn
    (setq cCen(vlax-get obj 'Centroid)
   cVol(vlax-get obj 'Volume)
   cmvList(cons(list cCen cVol)cmvList)
   ); end setq
           ); end progn
  ))
  ); end if
); end foreach

   (if
     (and
cmcList
(/= 1(length cmcList))
); enad and
     (progn
(setq gCen
       (list

  (/
    (apply '+
       (mapcar '*
   (mapcar 'caar cmcList)(mapcar 'cadr cmcList)))
    (apply '+ (mapcar 'cadr cmcList))
    ); end /
  (/
    (apply '+
       (mapcar '*
   (mapcar 'cadar cmcList)(mapcar 'cadr cmcList)))
    (apply '+ (mapcar 'cadr cmcList))
    ); end /
  ); end list
      enPt (polar gCen(/ pi 3)
     (* (getvar "DIMTXT")(getvar "DIMSCALE") 5))
      ); end setq
(command "_.qleader" "_non" gCen "_non" enPt "" "" "#" "")
(vla-put-TextString
    (vlax-ename->vla-object(entlast))
    (strcat "x="(rtos(car gCen)2(getvar "DIMDEC"))
     "[url="file://\\P"]\\P[/url]"
     "y="(rtos(cadr gCen)2(getvar "DIMDEC"))
     ); end strcat
    ); end vla-put-TextString
(foreach pt(mapcar 'car cmcList)
  (command "_.line" "_non" pt  "_non" gCen "")
  (setq enPt(polar pt(/ pi 3)
     (*(getvar "DIMTXT")(getvar "DIMSCALE")5)))
  (command "_.qleader" pt enPt "" "" "#" "")
  (vla-put-TextString
    (vlax-ename->vla-object(entlast))
    (strcat "x="(rtos(car pt)2 2)
     "[url="file://\\P"]\\P[/url]"
     "y="(rtos(cadr pt)2 2)
     ); end strcat
    ); end vla-put-TextString
  ); end foreach
); end progn
     ); end if
(if
     (and
cmvList
(/= 1(length cmvList))
); enad and
     (progn
(setq gCen
       (list

  (/
    (apply '+
       (mapcar '*
   (mapcar 'caar cmvList)(mapcar 'cadr cmvList)))
    (apply '+ (mapcar 'cadr cmvList))
    ); end /
  (/
    (apply '+
       (mapcar '*
   (mapcar 'cadar cmvList)(mapcar 'cadr cmvList)))
    (apply '+ (mapcar 'cadr cmvList))
    ); end /
  ); end list
      enPt (polar gCen(/ pi 3)
     (* (getvar "DIMTXT")(getvar "DIMSCALE") 5))
      ); end setq
(command "_.qleader" "_non" gCen "_non" enPt "" "" "#" "")
(vla-put-TextString
    (vlax-ename->vla-object(entlast))
    (strcat "x="(rtos(car gCen)2(getvar "DIMDEC"))
     "[url="file://\\P"]\\P[/url]"
     "y="(rtos(cadr gCen)2(getvar "DIMDEC"))
     ); end strcat
    ); end vla-put-TextString
(foreach pt(mapcar 'car cmvList)
  (command "_.line" "_non" pt  "_non" gCen "")
  (setq enPt(polar pt(/ pi 3)
     (*(getvar "DIMTXT")(getvar "DIMSCALE")5)))
  (command "_.qleader" pt enPt "" "" "#" "")
  (vla-put-TextString
    (vlax-ename->vla-object(entlast))
    (strcat "x="(rtos(car pt)2 2)
     "[url="file://\\P"]\\P[/url]"
     "y="(rtos(cadr pt)2 2)
     ); end strcat
    ); end vla-put-TextString
  ); end foreach
); end progn
     )

     (mapcar 'setvar (list "OSMODE" "CMDECHO")(list oldSnp 1))
     (vla-EndUndoMark actDoc)
     ); end progn
   ); end if
 (princ)
 ); end of c:gec

~'J'~

I use this lsp code very good...

this code is too much help me

can we do some more work with this lsp

like i want to move my use on region center

& then region mass porperty insert into drawing as a text or mtext

Thanks & Regards

It worked only in the x and y axis. I tried adding the Z myself but only succeded in adding a z value that is the same value as the y.

(defun c:gec(/ actDoc cSet cLst oldSnp cCen cAre cmcList cmvList gCen enPt)

 (vl-load-com)

 (princ "\n<<<Select Regions or 3D-solids >>> ")
 (if(setq cSet(ssget '((0 . "REGION,3DSOLID"))))
   (progn
     (setq cLst(mapcar 'vlax-ename->vla-object
                      (vl-remove-if 'listp
                        (mapcar 'cadr(ssnamex cSet))))
    oldSnp(getvar "OSMODE")
    ); end setq
     (mapcar 'setvar (list "OSMODE" "CMDECHO")(list 0 0))
     (vla-StartUndoMark
(setq actDoc(vla-get-ActiveDocument
       (vlax-get-acad-object))))

     (foreach obj cLst
(if (vlax-property-available-p obj 'Centroid)
  (cond ((eq "AcDbRegion" (vla-get-objectname obj))
  (progn
    (setq cCen(vlax-get obj 'Centroid)
   cAre(vlax-get obj 'Area)
   cmcList(cons(list cCen cAre)cmcList)
   ); end setq
           ); end progn
  )
 ((eq "AcDb3dSolid" (vla-get-objectname obj))
  (progn
    (setq cCen(vlax-get obj 'Centroid)
   cVol(vlax-get obj 'Volume)
   cmvList(cons(list cCen cVol)cmvList)
   ); end setq
           ); end progn
  ))
  ); end if
); end foreach

   (if
     (and
cmcList
(/= 1(length cmcList))
); enad and
     (progn
(setq gCen
       (list

  (/
    (apply '+
       (mapcar '*
   (mapcar 'caar cmcList)(mapcar 'cadr cmcList)))
    (apply '+ (mapcar 'cadr cmcList))
    ); end /
  (/
    (apply '+
       (mapcar '*
   (mapcar 'cadar cmcList)(mapcar 'cadr cmcList)))
    (apply '+ (mapcar 'cadr cmcList))
    ); end /
  ); end list
      enPt (polar gCen(/ pi 3)
     (* (getvar "DIMTXT")(getvar "DIMSCALE") 5))
      ); end setq
(command "_.qleader" "_non" gCen "_non" enPt "" "" "#" "")
(vla-put-TextString
    (vlax-ename->vla-object(entlast))
    (strcat "x="(rtos(car gCen)2(getvar "DIMDEC"))
     "\\P"
     "y="(rtos(cadr gCen)2(getvar "DIMDEC"))
           "\\P"
     "z="(rtos(cadr gCen)2(getvar "DIMDEC"))
     ); end strcat
    ); end vla-put-TextString
(foreach pt(mapcar 'car cmcList)
  (command "_.line" "_non" pt  "_non" gCen "")
  (setq enPt(polar pt(/ pi 3)
     (*(getvar "DIMTXT")(getvar "DIMSCALE")5)))
  (command "_.qleader" pt enPt "" "" "#" "")
  (vla-put-TextString
    (vlax-ename->vla-object(entlast))
    (strcat "x="(rtos(car pt)2 2)
     "\\P"
     "y="(rtos(cadr pt)2 2)
"\\P"
     "z="(rtos(cadr pt)2 2)
     ); end strcat
    ); end vla-put-TextString
  ); end foreach
); end progn
     ); end if
(if
     (and
cmvList
(/= 1(length cmvList))
); enad and
     (progn
(setq gCen
       (list

  (/
    (apply '+
       (mapcar '*
   (mapcar 'caar cmvList)(mapcar 'cadr cmvList)))
    (apply '+ (mapcar 'cadr cmvList))
    ); end /
  (/
    (apply '+
       (mapcar '*
   (mapcar 'cadar cmvList)(mapcar 'cadr cmvList)))
    (apply '+ (mapcar 'cadr cmvList))
    ); end /
  ); end list
      enPt (polar gCen(/ pi 3)
     (* (getvar "DIMTXT")(getvar "DIMSCALE") 5))
      ); end setq
(command "_.qleader" "_non" gCen "_non" enPt "" "" "#" "")
(vla-put-TextString
    (vlax-ename->vla-object(entlast))
    (strcat "x="(rtos(car gCen)2(getvar "DIMDEC"))
     "\\P"
     "y="(rtos(cadr gCen)2(getvar "DIMDEC"))
"\\P"
     "z="(rtos(cadr gCen)2(getvar "DIMDEC"))
     ); end strcat
    ); end vla-put-TextString
(foreach pt(mapcar 'car cmvList)
  (command "_.line" "_non" pt  "_non" gCen "")
  (setq enPt(polar pt(/ pi 3)
     (*(getvar "DIMTXT")(getvar "DIMSCALE")5)))
  (command "_.qleader" pt enPt "" "" "#" "")
  (vla-put-TextString
    (vlax-ename->vla-object(entlast))
    (strcat "x="(rtos(car pt)2 2)
     "\\P"
     "y="(rtos(cadr pt)2 2)
           "\\P"
     "z="(rtos(cadr pt)2 2)
     ); end strcat
    ); end vla-put-TextString
  ); end foreach
); end progn
     )

     (mapcar 'setvar (list "OSMODE" "CMDECHO")(list oldSnp 1))
     (vla-EndUndoMark actDoc)
     ); end progn
   ); end if
 (princ)
 ); end of c:gec

i found one more good lsp with short code...

this lsp mark centriod of region... with circle...

know i want to move my ucs to region centriod... then mass property driectly into cad as a text

some one know about

massproperty.dwg

RCG.lsp

These lisps are great. Does anyone know if there is one that will generate a circle at the centre of gravity of a range of objects (as if they had been combined by the UNION command say).

If I have three objects, rather than three circles being generated, is it possible to create a circle at the very c.o.g for all three pieces (as if combined)?

It would be helpful for me to not combine them that was all. worth an ask.

Many thanks for any replies and to the above work that has been done.

Nathan

Hi

I am not able to upload file.

Give me your mail addres , i will send to you centroid routine.

Regards

Petkovski