joemcanciller Posted February 20 Posted February 20 (edited) 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. Edited February 20 by joemcanciller Added a sketch Quote
EnM4st3r Posted February 20 Posted February 20 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) ) 1 Quote
BIGAL Posted February 21 Posted February 21 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. Quote
Recommended Posts
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.