home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 8 / CDASC08.ISO / VRAC / SEP93CAD.ZIP / TIP894.LSP < prev    next >
Text File  |  1993-08-31  |  5KB  |  180 lines
  1. ;TIP894:  CLG.LSP  Center Line of Gravity   (C)1993, Richard Scott Woodhall
  2. ;        Usage : clg
  3. ;        This functions calculates the accumulated
  4. ;        centroid of mass of one or many plines se-
  5. ;        lected by the user.
  6.  
  7. (defun c:clg (/ i _Mx _My m ss ename value p a mi my mx x y oldpdmode oldpdsize)
  8.  
  9.    ; Initialize variables.
  10.  
  11.    (setq i 0
  12.          _Mx 0
  13.          _My 0
  14.          m 0
  15.    )
  16.  
  17.    ; Select objects.
  18.  
  19.    (princ "\nSelect all masses ...\n")
  20.    (setq ss (ssget))
  21.  
  22.    ; Loop invariant : repeat for all objects in
  23.    ; selection set.
  24.  
  25.    (repeat (sslength ss)
  26.       (setq ename (ssname ss i))
  27.  
  28.       (redraw ename 3)    ; Highlight object.
  29.  
  30.       (setq value (centroid ename)    ; Calculate centroid of object.
  31.             p (getreal "\nEnter density of highlighted mass <ie. thickness>: ")
  32.             a (caddr value)
  33.             mi (* p a)
  34.             my (* mi (car value))
  35.             mx (* mi (cadr value))
  36.             _Mx (+ _Mx mx)    ; Sum moments about the x-axis.
  37.             _My (+ _My my)    ; Sum moments about the y-axis.
  38.             m (+ m mi)    ; Sum masses.
  39.             i (1+ i)    ; Increment i.
  40.       )
  41.  
  42.       (redraw ename 4)    ; De-highlight object.
  43.    )
  44.  
  45.    ; Calculate accumulated centroid.
  46.  
  47.    (setq x (/ _My m)    
  48.          y (/ _Mx m)
  49.    )
  50.  
  51.    ; Save current system variables.
  52.  
  53.    (setq oldpdmode (getvar "PDMODE")
  54.          oldpdsize (getvar "PDSIZE")
  55.    )
  56.  
  57.    ; Set system variables.
  58.  
  59.    (setvar "CMDECHO" 0)
  60.    (setvar "PDMODE" 35)
  61.    (setvar "PDSIZE" (* (getvar "LTSCALE") 3))
  62.  
  63.    ; Draw a point at centroid and print x,y value.
  64.  
  65.    (command "POINT" (list x y))
  66.    (princ "\nCentroid of mass is located at coordinate ")
  67.    (princ x)
  68.    (princ ",")
  69.    (princ y)
  70.    (princ ".\n")
  71.  
  72.    ; Reset system variables to original values.
  73.  
  74.    (setvar "PDMODE" oldpdmode)
  75.    (setvar "PDSIZE" oldpdsize)
  76.  
  77.    (princ)
  78.  
  79. )
  80.  
  81. ;        Usage : (fline x x1 y1 x2 y2)
  82. ;        This function returns the y value of a
  83. ;        line for every x value passed it.
  84.  
  85. (defun fline (ui x1 y1 x2 y2)
  86.    (+ (* (/ (- y1 y2) (- x1 x2)) (- ui x2)) y2)
  87. )
  88.  
  89. ;        Usage : (centroid ename)
  90. ;        This function calculates the centroid of
  91. ;        mass of a pline object.
  92.  
  93. (defun centroid (ename / n e xbuf ybuf m _Mx _My _Dx ui xi yi mi x y x1 y1 x2 y2)
  94.  
  95.    ; Initialize variables.
  96.  
  97.    (setq n 100    ; Set number of iterations for summation.
  98.          e (entget (entnext (cdr (assoc -1 (entget ename)))))
  99.          x1 (cadr (assoc 10 e))
  100.          y1 (caddr (assoc 10 e))
  101.          xbuf x1
  102.          ybuf y1
  103.          e (entget (entnext (cdr (assoc -1 e))))
  104.          x2 (cadr (assoc 10 e))
  105.          y2 (caddr (assoc 10 e))
  106.          m 0
  107.          _Mx 0
  108.          _My 0
  109.    )
  110.  
  111.    ; Loop invariant : while not the end of the pline sequence.
  112.  
  113.    (while (/= "SEQEND" (cdr (assoc 0 e)))
  114.       (setq _Dx (/ (- x2 x1) n)
  115.             ui x1
  116.       )
  117.  
  118.       (if (/= x1 x2)    ; Check that pline segment is a true function.
  119.  
  120.          ; Loop invariant : repeat n number of times.
  121.  
  122.          (repeat n
  123.             (setq xi (+ ui (* 0.5 _Dx))
  124.                   yi (fline xi x1 y1 x2 y2)
  125.                   mi (* _Dx yi)
  126.                   m (+ m mi)    ; Sum masses of rectangles.
  127.                   _Mx (+ _Mx (* mi yi 0.5))    ; Sum moments about the x-axis.
  128.                   _My (+ _My (* mi xi))    ; Sum moments about the y-axis.
  129.                   ui (+ _Dx ui)    ; Increment ui.
  130.              )
  131.           )    ; End repeat.
  132.  
  133.       )    ; End if.
  134.  
  135.       (setq x1 x2
  136.             y1 y2
  137.             e (entget (entnext (cdr (assoc  -1 e))))    ; Increment e to next
  138.                                                         ; vertex.
  139.             x2 (cadr (assoc 10 e))
  140.             y2 (caddr (assoc 10 e))
  141.       )
  142.  
  143.    )    ; End while.
  144.  
  145.    (setq x2 xbuf
  146.          y2 ybuf
  147.          _Dx (/ (- x2 x1) n)
  148.          ui x1
  149.    )
  150.  
  151.    (if (/= x1 x2)    ; Check that pline segment is a true function.
  152.  
  153.       ; Loop invariant : repeat n number of times.
  154.  
  155.       (repeat n
  156.          (setq xi (+ ui (* 0.5 _Dx))
  157.                yi (fline xi x1 y1 x2 y2)
  158.                mi (* _Dx yi)
  159.                m (+ m mi)    ; Sum masses of rectangles.
  160.                _Mx (+ _Mx (* mi yi 0.5))    ; Sum moments about the x-axis.
  161.                _My (+ _My (* mi xi))    ; Sum moments about the y-axis.
  162.                ui (+ _Dx ui)    ; Increment ui.
  163.          )
  164.       )    ; End repeat.
  165.  
  166.    )    ; End if.
  167.  
  168. ; Calculate accumulated centroid.
  169.  
  170.    (setq x (/ _My m)
  171.          y (/ _Mx m)
  172.    )
  173.  
  174.    ; Return a list to calling function.
  175.  
  176.    (list x y (abs m))
  177.  
  178. )
  179. 
  180.