Jump to content

Horizontal line that divides the area of a region into 2 equal areas.


joemcanciller

Recommended Posts

Hi! Is there a way using Lisp to find the horizontal line that will divide the area of a region into two equal areas?

My primary intent is to determine the vertical distance (h) of that line in relation to the lowest point of the region.

Thanks in advance.

 

image.thumb.png.09060b58256eb6be58e9eb133bdf067c.png

 

Edited by joemcanciller
Added a sketch
Link to comment
Share on other sites

i once needed something similar, i found a function somewhere online that does that and modified it somewhat to my needs.
Its still somewhat clumpy but maybe it helps..

 


(defun c:divarea (/ *error* osmode cmdecho blipmode correctent-p ready fixpt parpt
                    answer ename divider area)
  
  (defun *error* (msg)
    (if osmode (setvar "osmode" osmode))
    (if cmdecho (setvar "cmdecho" cmdecho))
    (if blipmode (setvar "blipmode" blipmode))

    (princ (strcat "\nError: " msg))
    (princ)
  )
  
  (defun correctent-p (ent /)
    (if ent 
      (and 
        (= (cdr (assoc 0 (entget ent))) "LWPOLYLINE")
        (= (cdr (assoc 70 (entget ent))) 1)
      )
      nil
    )
  );defun
  
  (defun ready ()
    (setvar "osmode" osmode)
    (setvar "cmdecho" cmdecho)
    (setvar "blipmode" blipmode)
    (princ (strcat "\nFull Area : " (rtos area)))
    (princ (strcat "\nNew Area : " (rtos newarea)))
    (princ)
  );defun
  
  (defun initiate-parpt (newarea i / parpt getcenter divisionline boundarypoint oldline ptb temp newboundary pt1)
  
    (defun parpt (tem line pts / p1 p2 precision deln pts par linedata)
      (setvar "osmode" osmode)
      (setq precision (/ (vla-get-length (vlax-ename->vla-object line)) 10))

      (setvar "osmode" 0)
      (command "_line" p1 p2 "")
      (setq deln (entlast)) ;put line to delete later
      (if (not ptb) (setq ptb (getpoint "\nPick any point into the REST of the piece, FAR from division line: ")))
      (setvar "blipmode" 0)
      (princ "\nPlease wait...")
      (command "_boundary" pts "")
      (setq newboundary (entlast))
      (setq par (vla-get-area (vlax-ename->vla-object newboundary))) ;par = area created by boundary
      (while (> (abs (- par tem)) 0.00001)
        (if (< par tem)
          (progn
            (while (< par tem)
              (entdel newboundary) ;delete boundary
              (command "_offset" precision deln ptb "")
              (entdel deln)
              (setq deln (entlast))
              (command "_boundary" pts "")
              (setq newboundary (entlast))
              (setq par (vla-get-area (vlax-ename->vla-object newboundary)))
            )
          )
          (progn
            (while (> par tem)
              (entdel newboundary)
              (command "_offset" precision deln pts "")
              (entdel deln)
              (setq deln (entlast))
              (command "_boundary" pts "")
              (setq newboundary (entlast))
              (setq par (vla-get-area (vlax-ename->vla-object newboundary)))
            )
          )
        )
        (setq linedata (entget deln))
        (entdel deln)
        (setq precision (/ precision 1.5))
        (princ precision)
      )
      (command "_change" newboundary "" "_p" "_c" "_green" "")
      
      linedata
    );defun
    
    (defun getcenter (line1 line2 / p1 p2)
      (setq p1 (cdr (assoc 10 (entget line1))))
      (setq p2 (cdr (assoc 11 (entget line2))))
      (list
            (/ (+ (car p1) (car p2)) 2) ; x-coordinate of the center point
            (/ (+ (cadr p1) (cadr p2)) 2) ; y-coordinate of the center point
      )
    );defun
    
    (command  "_line"
              (setq pt1 (getpoint "\nPick one point of division line (far from lwpoly) : "))
              (getpoint pt1 "\nPick other point of division line (far from lwpoly) : ")
              ""
    )
    (setq divisionline (entlast))
    (setq boundarypoint (getpoint "\nPick any point into FIRST piece, FAR from division line: "))
    (setq temp (parpt newarea divisionline boundarypoint))
    
    (while (> i 2)
      (entmake temp)
      (setq oldline (entlast))
      (command "_offset" (/ (vla-get-length (vlax-ename->vla-object oldline)) 200) oldline ptb "")
      (setq divisionline (entlast))
      (setq boundarypoint (getcenter oldline divisionline))
      (entdel oldline)
      (setq temp (parpt newarea divisionline boundarypoint))
      (setq i (1- i))
    )
    (command "_boundary" ptb "")
    (setq newboundary (entlast))
    (command "_change" newboundary "" "_p" "_c" "_green" "")
  );defun
  
  (setq osmode (getvar "osmode")
        cmdecho (getvar "cmdecho")
        blipmode (getvar "blipmode")
  )

  (setvar "osmode" 0)
  (setvar "cmdecho" 0)

  (while (not (correctent-p ename))
    (setq ename (car (entsel "\nSelect closed LWPOLY to divide: ")))
  )
  
  (setq area (vla-get-area (vlax-ename->vla-object ename)))
  
  (initget "Divide Cut")
  (setq answer (cond ((getkword "\nDIVIDE by number or CUT a part ? [Divide/Cut] <Divide>: ")) ("Divide")))
  (if (= answer "Divide")
    (progn
      (setq divider  (cond ((getreal "\nEnter number to divide the whole part by <2>: ")) (2)))
      (setq newarea (/ area divider))
    )
    (setq newarea (getreal "\nArea to cut : "))
  )
  
  (initiate-parpt newarea divider)
  (ready)
)

 

  • Like 1
Link to comment
Share on other sites

If you search more there are various options about this area task, draw line enter area and line is moved parallel, use a swing line from a point, I know there were 2 more options. Used in land subdivisions.

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...