Area split equal.

October 18, 2013

First step

If you want to split your polygon to 5 pieces you will choose DIVIDE

if you want to split your polygon to pieces with specific area in (sq.m) you will sellect CUT

Second step

You have to choose PARALLEL line ,(far far far from lwpoly), this is the key be carefull

I use it in any area .

One tip for faster DIVIDE

If you choose as good as possible the nearest plase to put the parallel line the lisp will do faster the divide.

October 18, 2013

If you don't mind, I've modified the code to better suit prompting and little mistake with PARALLEL option (offsetting point was wrong)...

;;;DIVAREA.LSP  ver 2.0   Plot division utility (metric units)
;;;                       by Yorgos Angelopoulos
;;;                       agior1959@gmail.com
;;;
;;;  Suppose that you have to split a big part into 2, 3, 4 (even works for 5.014)
;;;  or you want to cut a smaller part out of the parent one.
;;;
;;;  All you need is a CLOSED polyline to define the parent part.
;;;
;;;  Load the utility, after placing it into an appropriate folder,
;;;  let's say \Program Files\Acad2000\Support, invoke "APPLOAD" command
;;;  or invoke (LOAD"DIVAREA") and run it by entering DIVAREA.
;;;
;;;  
;;;  For proper execution please note that:
;;;
;;;     1. The area which is enclosed by the poly must be FREE of
;;;          entities which could cause unexpected behaviour of the BOUNDARY
;;;          command (this command is the key to the solution). ERASE ALL lines,
;;;          polylines, circles, etc. inside the lwpoly. Text, nodes and attribs
;;;          may not interfere with the BOUNDARY command
;;;
;;;     2. The DIVISION LINE must CROSS THE BOUNDARY polyline,
;;;          is imaginary, you MUST NOT draw it, let the routine draw it,
;;;          just indicate its endpoints  
;;;          (you may have to draw auxilliary entities BEFORE you start DIVAREA)
;;;
;;;     3. Bear in mind that this DIVISION LINE will be rotated (or be offseted) and
;;;         neither of its endpoints should be inside the boundary, at
;;;         any moment, or else the result will be unexpected.
;;;
;;;     4. An easy way to help things going, is to indicate the two
;;;         end-points as FAR OUT from the boundary as possible, not exceeding
;;;         of course, your current visibe area.
;;;
;;;     5. The only exception is for the FIXED POINT, in case that 
;;;          you prefer "F" rather than "P" as an answer in the relevant question.
;;;          Fixed point must be ON or OUTSIDE the polyline, NEVER INSIDE.
;;;
;;;     6. Next, pick a point into the part which will obtain the desired
;;;         area. You have to indicate INTO it, NOT ON the boundary and AS FAR
;;;         from division line as possible, so this point will not be outside of
;;;         the desired part while the division line is moving towards the point.
;;;
;;;     7. Finally, you have to indicate the remaining part, exactly 
;;;          by the same way, FAR FROM DIVISION line and INTO the remaining piece.
;;;
;;;     8. For better area approximation you can decrease local vars
;;;         stp2 and stp1 in the following program-lines accordingly.
;;;
;;;******************UTILITY STARTS HERE*******************************
(defun getver_poly (entnme / subent pllst vertex)    ;;POLYLINE VERTICES LIST
(setq subent (entnext entnme))
(setq pllst '())
(while subent
 (setq vertex (cdr (assoc 10 (entget subent))))
 (setq pllst (append pllst (list vertex)))
 (setq subent (entnext subent))
)
pllst
)
;;*********************************************************************
(defun getver_lwpoly (entnme / oldpl nodpl ptyp i n pllst)    ;;LWPOLYLINE VERTICES LIST
(setq oldpl(entget entnme))
(setq nodpl(cdr(assoc 90 oldpl)))
(setq ptyp (cdr(assoc 70 oldpl)))
(setq pllst '())
(setq i 0)
(setq n 0)
(while (car(nth i oldpl))
       (if (= (car(nth i oldpl)) 10) 
              (progn
                    (setq pllst (append pllst (list (cdr(nth i oldpl)))))
                    (setq n(+ 1 n))
              );endprogn
       );endif
        (setq i (+ i 1))
);endwhile
(if (= ptyp 1)
  (progn
        (setq pllst (append pllst (list(nth 0 pllst))))
        (setq pllst (cdr pllst))
  );endprogn     
);endif
pllst
)
;;*********************************************************************
(defun prerr (s)
(if (/= s "Function cancelled")
    (princ (strcat "\nError: " s))
);endif
(setq *error* olderr)
(princ)
);close defun
;;*********************************************************************
(Defun C:DIVAREA (/ osm strpf strdc ex arxent arx arxon pllst k scl ok 
                   d p1 p2 pta pts ptb deln ar par tem
                   stp stp1 stp2                
                )
(setq olderr *error*
      *error* prerr)
(setq osm(getvar "osmode"))
(setvar "osmode" 0)
(setvar "cmdecho" 0)
(setq ex 0
      stp  0.10
      stp1 0.05
      stp2 0.005
)
(setq arxent (car(entsel "\nSelect a CLOSED polyline : "))
      arx (entget arxent)
      arxon  (cdr (assoc -1 arx))
)
(if (not
        (and
            (or
            (equal (cdr(assoc 0 arx)) "LWPOLYLINE")
            (equal (cdr(assoc 0 arx)) "POLYLINE")
            )
            (= (cdr(assoc 70 arx)) 1)
        )
    )
    (progn
          (princ "\nSORRY, ONLY CLOSED POLYLINES ALLOWED...")
          (setq ex 1)
    )
)
(if (= ex 0)
    (progn
      (command "_undo" "m") ;if something goes bad, you may return here
      (if (equal (cdr(assoc 0 arx)) "LWPOLYLINE")
          (setq pllst (getver_lwpoly arxent))
          (setq pllst (getver_poly arxent))
      )
      (command "_layer" "m" "Area_Division" "")
      (command "_area" "e" arxon)
      (setq ar(getvar "area"))
      (initget "Divide Cut" 1)
      (setq strdc(getkword "\nDIVIDE by number or CUT a part ? (D/C) :")) 
      (if (= strdc "Divide")
          (progn
                (setq k  (getreal "\nEnter number to divide the whole part by : "))
                (setq tem(/ ar k))
          )
          (setq tem (getreal "\nEnter area to cut from the whole part (m2) : "))
      )
      (initget "Parallel Fixed" 1)
      (setq strpf(getkword "\nPARALLEL to a direction or FIXED side? (P/F) :")) 
      (if (= strpf "Fixed")
          (fixpt)
          (parpt)
      )
    )
    (ready)
)
)
;******************************************************************************
(defun fixpt ()
(setvar "osmode" osm)
(setq scl    0.05
      p1     (getpoint "\nPick fixed point of the division line - OUTSIDE of boundary: ")
      p2     (getpoint p1 "\nPick second point of division line - must completly CROSS boundary: ")
)
(setvar "osmode" 0)
(command "_line" p1 p2 "")
(setq deln (entlast))
(setq pts (getpoint "\nPick any point into the REST of the piece, FAR from division line - INSIDE of boundary: "))
(setq ptb (getpoint "\nPick any point into the FIRST piece, FAR from division line - INSIDE of boundary: "))
(setvar "blipmode" 0)
(princ "\nPlease wait...")
(command "_boundary" pts "")
(command "_area" "e" "l")
(setq par(getvar "area"))
(setq ok -1)
(if (< par tem)
 (progn
       (while (< par tem)
        (entdel (entlast))
        (if (< (- tem par) 50)(setq scl stp))
        (if (< (- tem par) 10)(setq scl stp2))
        (command "_rotate" deln "" p1 (* scl ok))
        (command "_boundary" pts "")
        (command "_area" "e" "l")
        (if (< (getvar "area") par)
            (setq ok(* ok -1))
        )
        (setq par(getvar "area"))
       );endwhile
       (entdel deln)
)
 (progn
       (while (> par tem)
        (entdel (entlast))
        (if (< (- par tem) 50)(setq scl stp))
        (if (< (- par tem) 10)(setq scl stp2))
        (command "_rotate" deln "" p1 (* scl ok))
        (command "_boundary" pts "")
        (command "_area" "e" "l")
        (if (> (getvar "area") par)
            (setq ok(* ok -1))
        )
        (setq par(getvar "area"))
       );endwhile
       (entdel deln)
)
)
(command "_change" "l" "" "p" "c" "green" "")
(command "_boundary" ptb "")
(command "_change" "l" "" "p" "c" "red" "")
(ready)
)
;******************************************************************************
(defun parpt ()
(setvar "osmode" osm)
(setq scl    0.25
      p1     (getpoint "\nPick one point of division line (far from lwpoly) : ")
      p2     (getpoint p1 "\nPick other point of division line (far from lwpoly) : ")
)
(setvar "osmode" 0)
(command "_line" p1 p2 "")
(setq deln(entlast))
(setq pta (getpoint "\nPick any point into the FIRST piece, FAR from division line - INSIDE of boundary: "))
(setq pts (getpoint "\nPick any point into the REST of the piece, FAR from division line - INSIDE of boundary: "))
(setq ptb (getpoint "\nPick any point from the REST of the piece, FAR from division line - OUTSIDE of boundary: "))
(setvar "blipmode" 0)
(princ "\nPlease wait...")
(command "_boundary" pts "")
(command "_area" "e" "l")
(setq par(getvar "area"))
(if (< par tem)
 (progn
       (while (< par tem)
        (entdel (entlast))
        (if (< (- tem par) 50)(setq scl stp1))
        (if (< (- tem par) 10)(setq scl stp2))
        (command "_offset" scl deln ptb "")
        (entdel deln)
        (setq deln(entlast))
        (command "_boundary" pts "")
        (command "_area" "e" "l")
        (setq par(getvar "area"))
       )
       (entdel deln)
 )
 (progn
       (while (> par tem)
        (entdel (entlast))
        (if (< (- par tem) 50)(setq scl stp1))
        (if (< (- par tem) 10)(setq scl stp2))
        (command "_offset" scl deln ptb "")
        (entdel deln)
        (setq deln(entlast))
        (command "_boundary" pts "")
        (command "_area" "e" "l")
        (setq par(getvar "area"))
       )
       (entdel deln)
 )
)
(command "_change" "l" "" "p" "c" "green" "")
(command "_boundary" pta "")
(command "_change" "l" "" "p" "c" "red" "")
(ready)
)
;******************************************************************************
(defun ready ()
 (princ scl)
 (princ "\nActual : ")
 (princ par)
 (princ "\nMust be: ")
 (princ tem)
(setq *error* olderr)
(setvar "osmode" osm)
(setvar "cmdecho" 1)
(setvar "blipmode" 1)
(princ "\nThanks...")
(princ)
);close defun

M.R.

October 21, 2013

If you don't mind, I've modified the code to better suit prompting and little mistake with PARALLEL option (offsetting point was wrong)...
M.R.

Marko_ribar, thanks about the code, but, I don't know what's going on, I'm trying to split one area, so, the picture below show you the result, I'm doing some thing wrong?...

Thanks again...

October 22, 2013

Nothing wrong, you picked points correctly... Split area is in green - it's 1/5 of major area... To split it from left to right, you must create cut line on the right and pick points from right to left (the same way you did from left to right)... Then you repeat step, but you select red pline and type 4 pieces, and so on... 3 pieces, 2 pieces and that's it - all area is split by 5 pieces with relatively correct areas...

October 22, 2013

Nothing wrong, you picked points correctly... Split area is in green - it's 1/5 of major area... To split it from left to right, you must create cut line on the right and pick points from right to left (the same way you did from left to right)... Then you repeat step, but you select red pline and type 4 pieces, and so on... 3 pieces, 2 pieces and that's it - all area is split by 5 pieces with relatively correct areas...

Hummm... Thanks a lot Marko_ribar!... It's working!!!... I was waiting to split it on 5 pieces at same time!...

Using the command appears one mesage (picture below), If I chose no, the command goes on, but if I chose , the command is canceled and at command line you can see below:

Select a CLOSED polyline :

; User warning: assignment to protected symbol: ARX

7ffff165ac0>) (0 . "LWPOLYLINE") (330 . ) ... )

Command:

January 9, 2014

Sorry marko_ribar but the first code has better results

;;;DIVAREA.LSP  ver 2.0   Plot division utility (metric units)
;;;                       by Yorgos Angelopoulos
;;;                       agior1959@gmail.com
;;;
;;;  Suppose that you have to split a big part into 2, 3, 4 (even works for 5.014)
;;;  or you want to cut a smaller part out of the parent one.
;;;
;;;  All you need is a CLOSED polyline to define the parent part.
;;;
;;;  Load the utility, after placing it into an appropriate folder,
;;;  let's say \Program Files\Acad2000\Support, invoke "APPLOAD" command
;;;  or invoke (LOAD"DIVAREA") and run it by entering DIVAREA.
;;;
;;;  
;;;  For proper execution please note that:
;;;
;;;     1. The area which is enclosed by the poly must be FREE of
;;;          entities which could cause unexpected behaviour of the BOUNDARY
;;;          command (this command is the key to the solution). ERASE ALL lines,
;;;          polylines, circles, etc. inside the lwpoly. Text, nodes and attribs
;;;          may not interfere with the BOUNDARY command
;;;
;;;     2. The DIVISION LINE must CROSS THE BOUNDARY polyline,
;;;          is imaginary, you MUST NOT draw it, let the routine draw it,
;;;          just indicate its endpoints  
;;;          (you may have to draw auxilliary entities BEFORE you start DIVAREA)
;;;
;;;     3. Bear in mind that this DIVISION LINE will be rotated (or be offseted) and
;;;         neither of its endpoints should be inside the boundary, at
;;;         any moment, or else the result will be unexpected.
;;;
;;;     4. An easy way to help things going, is to indicate the two
;;;         end-points as FAR OUT from the boundary as possible, not exceeding
;;;         of course, your current visibe area.
;;;
;;;     5. The only exception is for the FIXED POINT, in case that 
;;;          you prefer "F" rather than "C" as an answer in the relevant question.
;;;          Fixed point must be ON or OUTSIDE the polyline, NEVER INSIDE.
;;;
;;;     6. Next, pick a point into the part which will obtain the desired
;;;         area. You have to indicate INTO it, NOT ON the boundary and AS FAR
;;;         from division line as possible, so this point will not be outside of
;;;         the desired part while the division line is moving towards the point.
;;;
;;;     7. Finally, you have to indicate the remaining part, exactly 
;;;          by the same way, FAR FROM DIVISION line and INTO the remaining piece.
;;;
;;;     8. For better area approximation you can decrease local vars
;;;         stp2 and stp1 in the following program-lines accordingly.
;;;
;;;******************UTILITY STARTS HERE*******************************
(defun getver_poly (entnme / subent pllst vertex)    ;;POLYLINE VERTICES LIST
(setq subent (entnext entnme))
(setq pllst '())
(while subent
 (setq vertex (cdr (assoc 10 (entget subent))))
 (setq pllst (append pllst (list vertex)))
 (setq subent (entnext subent))
)
pllst
)
;;*********************************************************************
(defun getver_lwpoly (entnme / oldpl nodpl ptyp i n pllst)    ;;LWPOLYLINE VERTICES LIST
(setq oldpl(entget entnme))
(setq nodpl(cdr(assoc 90 oldpl)))
(setq ptyp (cdr(assoc 70 oldpl)))
(setq pllst '())
(setq i 0)
(setq n 0)
(while (car(nth i oldpl))
       (if (= (car(nth i oldpl)) 10) 
              (progn
                    (setq pllst (append pllst (list (cdr(nth i oldpl)))))
                    (setq n(+ 1 n))
              );endprogn
       );endif
        (setq i (+ i 1))
);endwhile
(if (= ptyp 1)
  (progn
        (setq pllst (append pllst (list(nth 0 pllst))))
        (setq pllst (cdr pllst))
  );endprogn     
);endif
pllst
)
;;*********************************************************************
(defun prerr (s)
(if (/= s "Function cancelled")
    (princ (strcat "\nError: " s))
);endif
(setq *error* olderr)
(princ)
);close defun
;;*********************************************************************
(Defun C:DIVAREA(/ osm strpf strdc ex arxent arx arxon pllst k scl ok 
                  d p1 p2 pts ptb deln ar par tem
                  stp stp1 stp2                
               )
(setq olderr *error*
      *error* prerr)
(setq osm(getvar "osmode"))
(setvar "osmode" 0)
(setvar "cmdecho" 0)
(setq ex 0
      stp  0.10
      stp1 0.05
      stp2 0.005
)
(setq arxent (car(entsel "\nSelect a CLOSED polyline : "))
      arx (entget arxent)
      arxon  (cdr (assoc -1 arx))
)
(if (not
        (and
            (or
            (equal (cdr(assoc 0 arx)) "LWPOLYLINE")
            (equal (cdr(assoc 0 arx)) "POLYLINE")
            )
            (= (cdr(assoc 70 arx)) 1)
        )
    )
    (progn
          (princ "\nSORRY, ONLY CLOSED POLYLINES ALLOWED...")
          (setq ex 1)
    )
)
(if (= ex 0)
    (progn
      (command "_undo" "m") ;if something goes bad, you may return here
      (if (equal (cdr(assoc 0 arx)) "LWPOLYLINE")
          (setq pllst (getver_lwpoly arxent))
          (setq pllst (getver_poly arxent))
      )
      (command "_layer" "m" "Area_Division" "")
      (command "_area" "e" arxon)
      (setq ar(getvar "area"))
      (initget "Divide Cut" 1)
      (setq strdc(getkword "\nDIVIDE by number or CUT a part ? (D/C) :")) 
      (if (= strdc "Divide")
          (progn
                (setq k  (getreal "\nEnter number to divide the whole part by : "))
                (setq tem(/ ar k))
          )
          (setq tem (getreal "\nEnter area to cut from the whole part (m2) : "))
      )
      (initget "Parallel Fixed" 1)
      (setq strpf(getkword "\nPARALLEL to a direction or FIXED side? (P/F) :")) 
      (if (= strpf "Fixed")
          (fixpt)
          (parpt)
      )
    )
    (ready)
)
)
;******************************************************************************
(defun fixpt ()
(setvar "osmode" osm)
(setq scl    0.05
      p1     (getpoint "\nPick fixed point of the division line : ")
      p2     (getpoint "\nPick second point of division line: ")
)
(setvar "osmode" 0)
(command "_line" p1 p2 "")
(setq deln (entlast))
(setq pts (getpoint "\nPick any point into FIRST piece, FAR from division line: "))
(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 "")
(command "_area" "e" "l")
(setq par(getvar "area"))
(setq ok -1)
(if (< par tem)
 (progn
       (while (< par tem)
        (entdel (entlast))
        (if (< (- tem par) 50)(setq scl stp))
        (if (< (- tem par) 10)(setq scl stp2))
        (command "_rotate" deln "" p1 (* scl ok))
        (command "_boundary" pts "")
        (command "_area" "e" "l")
        (if (< (getvar "area") par)
            (setq ok(* ok -1))
        )
        (setq par(getvar "area"))
       );endwhile
       (entdel deln)
)
 (progn
       (while (> par tem)
        (entdel (entlast))
        (if (< (- par tem) 50)(setq scl stp))
        (if (< (- par tem) 10)(setq scl stp2))
        (command "_rotate" deln "" p1 (* scl ok))
        (command "_boundary" pts "")
        (command "_area" "e" "l")
        (if (> (getvar "area") par)
            (setq ok(* ok -1))
        )
        (setq par(getvar "area"))
       );endwhile
       (entdel deln)
)
)
(command "_change" "l" "" "p" "c" "green" "")
(command "_boundary" ptb "")
(command "_change" "l" "" "p" "c" "red" "")
(ready)
)
;******************************************************************************
(defun parpt ()
(setvar "osmode" osm)
(setq scl    0.25
      p1     (getpoint "\nPick one point of division line (far from lwpoly) : ")
      p2     (getpoint "\nPick other point of division line (far from lwpoly) : ")
)
(setvar "osmode" 0)
(command "_line" p1 p2 "")
(setq deln(entlast))
(setq pts (getpoint "\nPick any point into FIRST piece, FAR from division line: "))
(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 "")
(command "_area" "e" "l")
(setq par(getvar "area"))
(if (< par tem)
 (progn
       (while (< par tem)
        (entdel (entlast))
        (if (< (- tem par) 50)(setq scl stp1))
        (if (< (- tem par) 10)(setq scl stp2))
        (command "_offset" scl deln ptb "")
        (entdel deln)
        (setq deln(entlast))
        (command "_boundary" pts "")
        (command "_area" "e" "l")
        (setq par(getvar "area"))
       )
       (entdel deln)
 )
 (progn
       (while (> par tem)
        (entdel (entlast))
        (if (< (- par tem) 50)(setq scl stp1))
        (if (< (- par tem) 10)(setq scl stp2))
        (command "_offset" scl deln pts "")
        (entdel deln)
        (setq deln(entlast))
        (command "_boundary" pts "")
        (command "_area" "e" "l")
        (setq par(getvar "area"))
       )
       (entdel deln)
 )
)
(command "_change" "l" "" "p" "c" "green" "")
(command "_boundary" ptb "")
(command "_change" "l" "" "p" "c" "red" "")
(ready)
)
;******************************************************************************
(defun ready ()
 (princ scl)
 (princ "\nActual : ")
 (princ par)
 (princ "\nMust be: ")
 (princ tem)
(setq *error* olderr)
(setvar "osmode" osm)
(setvar "cmdecho" 1)
(setvar "blipmode" 1)
(princ "\nThanks...")
(princ)
);close defun

February 17, 2016

My results in AutoCAD Civil3d:

Command: PL PLINE
Specify start point:

Current line-width is 0.0000

Specify next point or [Arc/Halfwidth/Length/Undo/Width]:

Specify next point or [Arc/Close/Halfwidth/Length/Undo/Width]:

Specify next point or [Arc/Close/Halfwidth/Length/Undo/Width]:

Specify next point or [Arc/Close/Halfwidth/Length/Undo/Width]: c

Command: DIVAREA

Select a CLOSED polyline :

SORRY, ONLY CLOSED POLYLINES ALLOWED...nil

Actual : nil

Must be: nil

Thanks...

Now tell me what did i do wrong?

Ow... and how can i turn the blips off, after DIVAREA is done?

February 17, 2016

Found the blipmode...:

.BLIPMODE

Command: .BLIPMODE
Enter mode [ON/OFF] : off

February 18, 2017

I know it's old thread but maybe someone will find this useful.

I change Ribar's code a little for my personal use so now it works lot faster and had better precision (0.00001 m^2)

Starting step ("korak" variable) of offsetting is set to 1m (so if you work with small areas/polygons that are shorter then lets say 10m or so, you need to change that to smaller value)

ok.... the code:

(defun prerr (s)
(if (/= s "Function cancelled")
    (princ (strcat "\nError: " s))
);endif
(setq *error* olderr)
(princ)
);close defun
(Defun C:DIVAREA(/ osm strpf strdc ex arxset arx arxon k scl ok
                  d p1 p2 pts ptb deln ar par tem
                  stp stp1 stp2               
               )
(setq olderr *error*
      *error* prerr)
(setq osm(getvar "osmode"))
(setvar "osmode" 0)
(setvar "cmdecho" 0)
(setq ex 0
	korak 1.00
	korak2 0.1
      
)
(setq arxset (entsel "\nSelect closed LWPOLY to divide: ")
      arx    (entget(car arxset))
      arxon  (cdr (assoc -1 arx))
)
(if (not(and(equal (cdr(assoc 0 arx)) "LWPOLYLINE") (= (cdr(assoc 70 arx)) 1)))
    (progn
          (princ "\nSORRY, ONLY CLOSED LWPOLYLINES ALLOWED...")
          (setq ex 1)
    )
)
(if (= ex 0)
    (progn
      (command "_undo" "m") ;if something goes bad, you may return here
      (command "_layer" "m" "Area_Division" "")
      (command "_area" "e" arxon)
      (setq ar(getvar "area"))
      (initget "Divide Cut")
      (setq strdc(getkword "\nDIVIDE by number or CUT a part ? (D/C) :"))
      (if (= strdc "Divide")
          (progn
                (setq k  (getreal "\nEnter number to divide the whole part by : "))
                (setq tem(/ ar k))
          )
      )
      (if (= strdc "Cut")
          (setq tem (getreal "\nEnter area to cut from the whole part (m2) : "))
      )
      (initget "Parallel Fixed")
      (setq strpf(getkword "\nPARALLEL to a direction or FIXED side? (P/F) :"))
      (if (= strpf "Fixed")
          (fixpt)
      )
      (if (= strpf "Parallel")
          (parpt)
      )
      (ready)
    )
    (ready)
)
)
;******************************************************************************
(defun fixpt ()
(setvar "osmode" osm)
(setq scl    0.05
      p1     (getpoint "\nPick fixed point of the division line : ")
      p2     (getpoint "\nPick second point of division line: ")
)
(setvar "osmode" 0)
(command "_line" p1 p2 "")
(setq deln (entlast))
(setq pts (getpoint "\nPick any point into FIRST piece, FAR from division line: "))
(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 "")
(command "_area" "e" "l")
(setq par(getvar "area"))
(setq ok -1)

(while(> (abs (- par tem)) 0.00001)
(if (< par tem)
 (progn
       (while (< par tem)
        (entdel (entlast))
        (setq scl korak2)
        
        (command "_rotate" deln "" p1 (* scl ok))
        (command "_boundary" pts "")
        (command "_area" "e" "l")
        (if (< (getvar "area") par)
            (setq ok(* ok -1))
        )
        (setq par(getvar "area"))
       );endwhile
       )
 (progn
       (while (> par tem)
        (entdel (entlast))
        (setq scl korak2)
        (command "_rotate" deln "" p1 (* scl ok))
        (command "_boundary" pts "")
        (command "_area" "e" "l")
        (if (> (getvar "area") par)
            (setq ok(* ok -1))
        )
        (setq par(getvar "area"))
       );endwhile
	))

(setq korak2 (/ korak2 1.2))
)
(command "_change" "l" "" "p" "c" "green" "")
(command "_boundary" ptb "")
(command "_change" "l" "" "p" "c" "red" "")
(ready)
)
;******************************************************************************
(defun parpt ()
(setvar "osmode" osm)
(setq scl    0.25
      p1     (getpoint "\nPick one point of division line (far from lwpoly) : ")
      p2     (getpoint "\nPick other point of division line (far from lwpoly) : ")
)
(setvar "osmode" 0)
(command "_line" p1 p2 "")
(setq deln(entlast))
(setq pts (getpoint "\nPick any point into FIRST piece, FAR from division line: "))
(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 "")
(command "_area" "e" "l")
(setq par(getvar "area"))
(while (> (abs (- par tem)) 0.00001)
(if (< par tem)
 (progn
       (while (< par tem)
        (entdel (entlast))
       (setq scl korak)
        (command "_offset" scl deln ptb "")
        (entdel deln)
        (setq deln(entlast))
        (command "_boundary" pts "")
        (command "_area" "e" "l")
        (setq par(getvar "area"))
       )
       (entdel deln)
 )
 (progn
       (while (> par tem)
        (entdel (entlast))
        (setq scl korak)
        (command "_offset" scl deln pts "")
        (entdel deln)
        (setq deln(entlast))
        (command "_boundary" pts "")
        (command "_area" "e" "l")
        (setq par(getvar "area"))
       )
       (entdel deln)
 )
)
(setq korak (/ korak 1.5))
(princ korak)
)
(command "_change" "l" "" "p" "c" "green" "")
(command "_boundary" ptb "")
(command "_change" "l" "" "p" "c" "red" "")
)
;******************************************************************************
(defun ready ()
 (princ scl)
 (princ "\nActual : ")
 (princ par)
 (princ "\nMust be: ")
 (princ tem)
(setq *error* olderr)
(setvar "osmode" osm)
(setvar "cmdecho" 1)
(setvar "blipmode" 1)
(princ "\nThanks...")
(princ)
);close defun

February 18, 2017

This is better version. Now you dont have to thing about size of polygon and offset step

(defun prerr (s)
(if (/= s "Function cancelled")
    (princ (strcat "\nError: " s))
);endif
(setq *error* olderr)
(princ)
);close defun
(Defun C:DIVAREA(/ osm strpf strdc ex arxset arx arxon k scl ok
                  d p1 p2 pts ptb deln ar par tem
                  stp stp1 stp2               
               )
(setq olderr *error*
      *error* prerr)
(setq osm(getvar "osmode"))
(setvar "osmode" 0)
(setvar "cmdecho" 0)
(setq ex 0
	;korak 3.00
	korak2 0.1
      
)
(setq arxset (entsel "\nSelect closed LWPOLY to divide: ")
      arx    (entget(car arxset))
      arxon  (cdr (assoc -1 arx))
)
(if (not(and(equal (cdr(assoc 0 arx)) "LWPOLYLINE") (= (cdr(assoc 70 arx)) 1)))
    (progn
          (princ "\nSORRY, ONLY CLOSED LWPOLYLINES ALLOWED...")
          (setq ex 1)
    )
)
(if (= ex 0)
    (progn
      (command "_undo" "m") ;if something goes bad, you may return here
      (command "_layer" "m" "Area_Division" "")
      (command "_area" "e" arxon)
      (setq ar(getvar "area"))
      (initget "Divide Cut")
      (setq strdc(getkword "\nDIVIDE by number or CUT a part ? (D/C) :"))
      (if (= strdc "Divide")
          (progn
                (setq k  (getreal "\nEnter number to divide the whole part by : "))
                (setq tem(/ ar k))
          )
      )
      (if (= strdc "Cut")
          (setq tem (getreal "\nEnter area to cut from the whole part (m2) : "))
      )
      (initget "Parallel Fixed")
      (setq strpf(getkword "\nPARALLEL to a direction or FIXED side? (P/F) :"))
      (if (= strpf "Fixed")
          (fixpt)
      )
      (if (= strpf "Parallel")
          (parpt)
      )
      (ready)
    )
    (ready)
)
)
;******************************************************************************
(defun fixpt ()
(setvar "osmode" osm)
(setq scl    0.05
      p1     (getpoint "\nPick fixed point of the division line : ")
      p2     (getpoint "\nPick second point of division line: ")
)
(setvar "osmode" 0)
(command "_line" p1 p2 "")
(setq deln (entlast))
(setq pts (getpoint "\nPick any point into FIRST piece, FAR from division line: "))
(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 "")
(command "_area" "e" "l")
(setq par(getvar "area"))
(setq ok -1)

(while(> (abs (- par tem)) 0.00001)
(if (< par tem)
 (progn
       (while (< par tem)
        (entdel (entlast))
        (setq scl korak2)
        
        (command "_rotate" deln "" p1 (* scl ok))
        (command "_boundary" pts "")
        (command "_area" "e" "l")
        (if (< (getvar "area") par)
            (setq ok(* ok -1))
        )
        (setq par(getvar "area"))
       );endwhile
       )
 (progn
       (while (> par tem)
        (entdel (entlast))
        (setq scl korak2)
        (command "_rotate" deln "" p1 (* scl ok))
        (command "_boundary" pts "")
        (command "_area" "e" "l")
        (if (> (getvar "area") par)
            (setq ok(* ok -1))
        )
        (setq par(getvar "area"))
       );endwhile
	))

(setq korak2 (/ korak2 1.2))
)
(command "_change" "l" "" "p" "c" "green" "")
(command "_boundary" ptb "")
(command "_change" "l" "" "p" "c" "red" "")
(ready)
)
;******************************************************************************
(defun parpt ()
(setvar "osmode" osm)
(setq scl    0.25
      p1     (getpoint "\nPick one point of division line (far from lwpoly) : ")
      p2     (getpoint "\nPick other point of division line (far from lwpoly) : ")
)
(setq korak (distance p1 p2))
(setq korak (/ korak 10))
(setvar "osmode" 0)
(command "_line" p1 p2 "")
(setq deln(entlast))
(setq pts (getpoint "\nPick any point into FIRST piece, FAR from division line: "))
(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 "")
(command "_area" "e" "l")
(setq par(getvar "area"))
(while (> (abs (- par tem)) 0.00001)
(if (< par tem)
 (progn
       (while (< par tem)
        (entdel (entlast))
       (setq scl korak)
        (command "_offset" scl deln ptb "")
        (entdel deln)
        (setq deln(entlast))
        (command "_boundary" pts "")
        (command "_area" "e" "l")
        (setq par(getvar "area"))
       )
       (entdel deln)
 )
 (progn
       (while (> par tem)
        (entdel (entlast))
        (setq scl korak)
        (command "_offset" scl deln pts "")
        (entdel deln)
        (setq deln(entlast))
        (command "_boundary" pts "")
        (command "_area" "e" "l")
        (setq par(getvar "area"))
       )
       (entdel deln)
 )
)
(setq korak (/ korak 1.5))
(princ korak)
)
(command "_change" "l" "" "p" "c" "green" "")
(command "_boundary" ptb "")
(command "_change" "l" "" "p" "c" "red" "")
)
;******************************************************************************
(defun ready ()
 (princ scl)
 (princ "\nActual : ")
 (princ par)
 (princ "\nMust be: ")
 (princ tem)
(setq *error* olderr)
(setvar "osmode" osm)
(setvar "cmdecho" 1)
(setvar "blipmode" 1)
(princ "\nThanks...")
(princ)
);close defun

March 21, 2017

This is better version. Now you dont have to thing about size of polygon and offset step

Hi Trmsa... Any new updates are welcome!!!... Thanks to support us!... ...

April 19, 2018

thank you very much for the updated version

it works way faster and has much more precision.

there is a little problem though.

The lisp deactivates my snap points. Other than that it works great.

I am trying to learn how to write lisps and i will study yours as i studied other lisps from mac lee, fixo and other coders.

Thank you again

April 19, 2018

Try to this:

(setq Old_osm (getvar "OSMODE"))

(setvar "OSMODE" 0) ; FOR NONE

Or (setvar "OSMODE" 97) ;end, int...

April 19, 2018

thanks EFL

i will try that

August 14, 2018

Good day.

I know very little about lisp, but I have included a couple of lines to this code.

Sometimes it does not work and I do not know why.

Please, if you can improve it, I'll thank you.

;;; DIVAREA.LSP Land division utility 
;;; written by Yorgos Angelopoulos 
;;; [email]aggior@panafonet.gr[/email] 
;;; ------------------------------------ 
;;; Traducción del código original al español, por Miguel A. Lázaro Marín 
;;; [url]http://perso.wanadoo.es/lm2ark[/url] 
;;; ------------------------------------ 
;;; Citando al autor original, Sr. Angelopoulos, y su posterior traductor 
;;; al Sr. Lázaro Marín  he planteado una variante al programa en la cual 
;;; si la solución es convergente, la va a encontrar con mayor velocidad 
;;; que la rutina original. Lea atentamente las instrucciones, en las que 
;;; hubo sutiles cambios
;;; por ,   Julio C. Jaramillo      [email]j_julio@hotmail.com[/email]
;;; ------------------------------------ 
;;; ------------------------------------ 
;;; Espero que el autor de este codigo no se moleste conmigo. Le he agregado
;;; un par de líneas a este lisp. En Windows 7 de 32bits con AutoCad 2019
;;; parece que trabaja sin ningún problema, no así en Windows 10 de 64bits en
;;; donde si da problemas.
;;; Si pueden corregir este lisp para que trabaje como debe, lo agradeceré.
;;; José Hernández           [email]josehernandezd@gmail.com[/email]
;;; ------------------------------------
;;; ------------------------------------
;;; Suponga que usted tiene que dividir una parcela grande de terreno entre 
;;; 2, 3, 4,...(¡o incluso dividirla entre 5.014!); o bien se desea cortar 
;;; una porción de 2345 m2 para segregarla de la parcela matriz u original. 
;;; 
;;; Todo lo que usted necesita es tener dibujada una "polilínea optimizada" 
;;; (entidad "LWPOLYLINE", incluída en AutoCAD a partir de su versión 14), 
;;; que se encuentre CERRADA y que coincida con el perímetro del área total 
;;; de la parcela a dividir. También una LÍNEA de DIVISIÓN en la cual comienza
;;; a iterar este rutina.
;;; 
;;; Cargue la utilidad, después de ponerla en un directorio apropiado, por 
;;; ejemplo el C:\Archivos de programa\AutoCAD\Support, bien sea 
;;; invocando el comando _APPLOAD o bien mediante (LOAD "DIVAREA"), y tras 
;;; la pertinente carga ejecutémosla escribiendo DIVAREA en la línea de 
;;; comandos. 
;;; 
;;; Conteste a las escasas preguntas que la rutina le irá formulando y 
;;; RECUERDE: 
;;; 
;;; Cuando le sea solicitado que SELECCIONE la línea de 
;;; división aproximada inicial, tenga presente lo siguiente: 
;;; 
;;; 1. Esta LÍNEA de DIVISIÓN será trasladada (en paralelo a la inicial) 
;;; o rotada (en función de la opción elegida) durante la ejecución de la 
;;; rutina, de manera que sus puntos inicial y final que definen la misma 
;;; deben marcarse teniendo en cuenta que, durante las aludidas traslación
;;; o rotación, no vayan a pasar hacia el interior del contorno definido 
;;; por la LWPLYLINE (aunque debe resultar fácil superar este inconveniente).
;;; Por tanto se aconseja que los puntos que definen LÍNEA de DIVISIÓN 
;;; inicial estén tan LEJANOS HACIA FUERA del perímetro como sea posible 
;;; sin exceder, por supuesto, el área actual visible de pantalla. 
;;; 
;;; En cuanto al punto o polo FIJO, en caso de que se haya preferido la 
;;; opción "F" en lugar de "P" (dirección PARALELA) como respuesta a la 
;;; pregunta anterior sobre el modo de generación de la línea divisoria, 
;;; dicho punto tiene que residir o bien sobre la polilínea o bien fuera 
;;; de ella, nunca dentro de la superficie delimitada a dividir. 
;;; 
;;; 2. Al indicar el punto sobre la porción en donde se obtendrá el área 
;;; deseada, habrá que señalarlo DENTRO de dicha porción y ALEJADA de la 
;;; línea de división tanto como sea posible, de forma que ese punto no 
;;; llegue a quedar fuera de la porción que se va obteniendo a medida que 
;;; la línea divisoria se mueve durante su proceso de cálculo. 
;;; 
;;; 3. Finalmente usted tendrá que indicar exactamente de la misma manera 
;;; un punto de la porción restante: DENTRO de ella y ALEJADA de la línea 
;;; de división. 
;;; 
;;; Si se desea mayor precisión de cálculo en la división del área, se 
;;; pueden AUMENTAR el valor de las variable local: STEP 
;;; 
;;;******************LA UTILIDAD COMIENZA AQUI*************************** 

(defun PRERR (S)
 (if (/= S "Function cancelled") (princ (strcat "\nError: " S)))
 (setq *error* OLDERR)
 (princ))

(defun C:DVA (/
   OSM    STRPF    STRDC    EX    STEP    ARXSET    ARX    ARXON
   K    OK    D    P1    P2    PTS    PTB    DELN    AR    PAR
   TEM    PJ1    PJ2    PJ1X    PJ2X    PJ1Y    PJ2Y    DISX
   DISY    PJN    PTSS    PTBB    DIST    DELNJ    DELN1    LINEAD)
 (setvar "osmode" 0)
 (setvar "cmdecho" 0)
 (setq vcs 1) (setq k 1)
 (setq OLDERR *error*
   *error* PRERR
   OSM (getvar "osmode")
   STEP 10
   EX 0
   ARXSET (entsel
     "\nSeleccione una LWPOLYLINE cerrada como perímetro del área a dividir: ")
   ARX (entget (car ARXSET))
   ARXON (cdr (assoc -1 ARX)))
 (if (not
     (and (equal (cdr (assoc 0 ARX)) "LWPOLYLINE") (= (cdr (assoc 70 ARX)) 1)))
   (progn
     (princ "\nDISCULPE, SOLO SE PERMITEN LWPOLYLINES CERRADAS...")
     (setq EX 1)))
 (if (= EX 0)
   (progn
     (command "_undo" "m" "_layer" "m" "Area_Division" "" "_area" "e" ARXON)
     (setq AR (getvar "area"))
     (initget "Divide Cut")
     (setq STRDC (getkword
         "\nDIVIDE por número de partes o [CORTA una superficie conocida]? (D/C): "))
     (if (= STRDC "Divide")
       (setq K (getreal "\nIntroduzca número por el que dividir el total: ")
         TEM (/ AR K)))
     (if (= STRDC "Cut")
       (progn
       (setq vcs 0)
       (setq TEM (getreal "\nIntroduzca el área a cortar del total (m2): "))))
     (initget "Parallel Fixed")
     (setq STRPF (getkword
         "\nLínea de corte PARALELA a una dirección o [por un polo FIJO]? (P/F) :"))
     (if (= STRPF "Fixed") (FIXPT))
     (if (= STRPF "Parallel") (PARPT))))
 (setq *error* OLDERR)
 (setvar "osmode" OSM)
 (setvar "cmdecho" 1)
 (setvar "blipmode" 0))
;******************************************************************************
(defun FIXPT ()
 (LINEA)
 (setvar "osmode" OSM)
 (setvar "osmode" 0)
 (command "_line" P1 P2 "")
 (setq DELN (entlast)
   PTS (getpoint
     "\nEscoja un punto DENTRO de la porción a obtener y ALEJADO de la línea divisoria: ")
   PTB (getpoint
     "\nEscoja cualquier punto del RESTO del área y ALEJADO de la línea divisoria: "))
 (setvar "blipmode" 0)
 (princ "\nPor favor, espere...")
 (setq PTSS PTS PTBB PTB)
 (command "_boundary" PTS "" "_area" "e" "l")
 (setq PAR (getvar "area") OK (if (< PAR TEM) 1 (if (> PAR TEM) -1 0)))
 (progn
   (while (/= OK 0) (SUPERIORF) (INFERIORF))
   (entdel DELN))
 (command
   "_change" "l" "" "p" "c" "green" ""
   "_boundary" PTBB ""
   "_change" "l" "" "p" "c" "red" ""))
;******************************************************************************
(defun SUPERIORF ()
 (if (= OK 1)
   (progn
     (entdel (entlast))
     (setq PJ2 PTB
       PJ1 (inters P1 P2 PTS PTB)
       PJ1X (car PJ1)
       PJ2X (car PJ2)
       PJ1Y (cadr PJ1)
       PJ2Y (cadr PJ2)
       DISX (/ (+ PJ1X PJ2X) 2)
       DISY (/ (+ PJ1Y PJ2Y) 2)
       PJN (list DISX DISY))
     (command
       "_rotate" DELN "" P1 "r" P1 P2 PJN
       "_boundary" PTSS ""
       "_area" "e" "l")
     (setq OK (if (> (getvar "area") TEM) -1 1) PTS PJ1 PTB PJ2 P2 PJN)
     (if (= (rtos (getvar "area") 2 STEP) (rtos TEM 2 STEP)) (setq OK 0))
     (setq PAR (getvar "area")))))
;******************************************************************************            
(defun INFERIORF ()
 (if (= OK -1)
   (progn
     (entdel (entlast))
     (setq PJ2 PTS
       PJ1 (inters P1 P2 PTS PTB)
       PJ1X (car PJ1)
       PJ2X (car PJ2)
       PJ1Y (cadr PJ1)
       PJ2Y (cadr PJ2)
       DISX (/ (+ PJ1X PJ2X) 2)
       DISY (/ (+ PJ1Y PJ2Y) 2)
       PJN (list DISX DISY))
     (command
       "_rotate" DELN "" P1 "r" P1 P2 PJN
       "_boundary" PTSS ""
       "_area" "e" "l")
     (setq OK (if (< (getvar "area") TEM) 1 -1) PTS PJ2 PTB PJ1 P2 PJN)
     (if (= (rtos (getvar "area") 2 STEP) (rtos TEM 2 STEP)) (setq OK 0))
     (setq PAR (getvar "area")))))
;******************************************************************************
(defun PARPT ()
 (while (< vcs k)
 (LINEA)
 (setvar "osmode" OSM)
 (setvar "osmode" 0)
 (command "_line" P1 P2 "")
 (setq DELN (entlast)
   PTS (getpoint
     "\nEscoja un punto DENTRO de la porción a obtener y ALEJADO de la línea divisoria: ")
   PTB (getpoint
     "\nEscoja cualquier punto del RESTO del área y ALEJADO de la línea divisoria: "))
 (setvar "blipmode" 0)
 (princ "\nPor favor, espere...")
 (setq PTSS PTS PTBB PTB)
 (command "_boundary" PTS "" "_area" "e" "l")
 (setq PAR (getvar "area") OK (if (< PAR TEM) 1 (if (> PAR TEM) -1 0)))
 (progn
   (while (/= OK 0) (SUPERIORP) (INFERIORP))
   (entdel DELN))
 (command
   "_change" "l" "" "p" "c" "green" ""
   "_boundary" PTBB ""
   "_change" "l" "" "p" "c" "red" "")
 (setq vcs (+ vcs 1))
))
;******************************************************************************
(defun SUPERIORP ()
 (if (= OK 1)
   (progn
     (entdel (entlast))
     (setq PJ2 PTB
       PJ1 (inters P1 P2 PTS PTB)
       PJ1X (car PJ1)
       PJ2X (car PJ2)
       PJ1Y (cadr PJ1)
       PJ2Y (cadr PJ2)
       DISX (/ (+ PJ1X PJ2X) 2)
       DISY (/ (+ PJ1Y PJ2Y) 2)
       PJN (list DISX DISY)
       DIST (distance PJ1 PJN))
     (command "_offset" DIST DELN PTBB "")
     (entdel DELN)
     (setq DELN (entlast))
     (command "_boundary" PTSS "" "_area" "e" "l")
     (setq OK (if (> (getvar "area") TEM) -1 1) PTS PJ1 PTB PJ2 P2 PJN)
     (if (= (rtos (getvar "area") 2 STEP) (rtos TEM 2 STEP)) (setq OK 0))
     (setq PAR (getvar "area")))))
;******************************************************************************
(defun INFERIORP ()
 (if (= OK -1)
   (progn
     (entdel (entlast))
     (setq PJ2 PTS
       PJ1 (inters P1 P2 PTS PTB)
       PJ1X (car PJ1)
       PJ2X (car PJ2)
       PJ1Y (cadr PJ1)
       PJ2Y (cadr PJ2)
       DISX (/ (+ PJ1X PJ2X) 2)
       DISY (/ (+ PJ1Y PJ2Y) 2)
       PJN (list DISX DISY)
       DIST (distance PJ1 PJN))
     (command "_offset" DIST DELN PTSS "")
     (entdel DELN)
     (setq DELN (entlast))
     (command "_boundary" PTSS "" "_area" "e" "l")
     (setq OK (if (< (getvar "area") TEM) 1 -1) PTS PJ2 PTB PJ1 P2 PJN)
     (if (= (rtos (getvar "area") 2 STEP) (rtos TEM 2 STEP)) (setq OK 0))
     (setq PAR (getvar "area")))))
;******************************************************************************
(defun LINEA ()
 (setq p1 (getpoint "\primer punto de la linea:"))
 (setq p2 (getpoint p1 "\segundo punto de la linea:"))
)

Edited August 15, 2018 by SLW210
Fixed Code Tags.

August 15, 2018

Please read the Code Posting Guidelines and have your Code to be included in Code Tags.[NOPARSE]

Your Code Here[/NOPARSE]

=

Your Code Here

You did not have your Code between the Code Tags.

August 16, 2018

Edit your post and change the color of the part you changed. Trying to run purpose written code can be difficult. Pick the word then the "A" with line under it colors will appear.

August 16, 2018

Good day. Bigal, thank you very much for your interest. In the following code I indicate which are the lines that you add, in blue. Thanks, again

 ;;; DIVAREA.LSP Land division utility 
;;; written by Yorgos Angelopoulos 
;;; aggior@panafonet.gr 
;;; ------------------------------------ 
;;; Traducción del código original al español, por Miguel A. Lázaro Marín 
;;; http://perso.wanadoo.es/lm2ark 
;;; ------------------------------------ 
;;; Citando al autor original, Sr. Angelopoulos, y su posterior traductor 
;;; al Sr. Lázaro Marín  he planteado una variante al programa en la cual 
;;; si la solución es convergente, la va a encontrar con mayor velocidad 
;;; que la rutina original. Lea atentamente las instrucciones, en las que 
;;; hubo sutiles cambios
;;; por ,   Julio C. Jaramillo      j_julio@hotmail.com
;;; ------------------------------------ 
;;; ------------------------------------ 
;;; Espero que el autor de este codigo no se moleste conmigo. Le he agregado
;;; un par de líneas a este lisp. En Windows 7 de 32bits con AutoCad 2019
;;; parece que trabaja sin ningún problema, no así en Windows 10 de 64bits en
;;; donde si da problemas.
;;; Si pueden corregir este lisp para que trabaje como debe, lo agradeceré.
;;; José Hernández           josehernandezd@gmail.com
;;; ------------------------------------
;;; ------------------------------------
;;; Suponga que usted tiene que dividir una parcela grande de terreno entre 
;;; 2, 3, 4,...(¡o incluso dividirla entre 5.014!); o bien se desea cortar 
;;; una porción de 2345 m2 para segregarla de la parcela matriz u original. 
;;; 
;;; Todo lo que usted necesita es tener dibujada una "polilínea optimizada" 
;;; (entidad "LWPOLYLINE", incluída en AutoCAD a partir de su versión 14), 
;;; que se encuentre CERRADA y que coincida con el perímetro del área total 
;;; de la parcela a dividir. También una LÍNEA de DIVISIÓN en la cual comienza
;;; a iterar este rutina.
;;; 
;;; Cargue la utilidad, después de ponerla en un directorio apropiado, por 
;;; ejemplo el C:\Archivos de programa\AutoCAD\Support, bien sea 
;;; invocando el comando _APPLOAD o bien mediante (LOAD "DIVAREA"), y tras 
;;; la pertinente carga ejecutémosla escribiendo DIVAREA en la línea de 
;;; comandos. 
;;; 
;;; Conteste a las escasas preguntas que la rutina le irá formulando y 
;;; RECUERDE: 
;;; 
;;; Cuando le sea solicitado que SELECCIONE la línea de 
;;; división aproximada inicial, tenga presente lo siguiente: 
;;; 
;;; 1. Esta LÍNEA de DIVISIÓN será trasladada (en paralelo a la inicial) 
;;; o rotada (en función de la opción elegida) durante la ejecución de la 
;;; rutina, de manera que sus puntos inicial y final que definen la misma 
;;; deben marcarse teniendo en cuenta que, durante las aludidas traslación
;;; o rotación, no vayan a pasar hacia el interior del contorno definido 
;;; por la LWPLYLINE (aunque debe resultar fácil superar este inconveniente).
;;; Por tanto se aconseja que los puntos que definen LÍNEA de DIVISIÓN 
;;; inicial estén tan LEJANOS HACIA FUERA del perímetro como sea posible 
;;; sin exceder, por supuesto, el área actual visible de pantalla. 
;;; 
;;; En cuanto al punto o polo FIJO, en caso de que se haya preferido la 
;;; opción "F" en lugar de "P" (dirección PARALELA) como respuesta a la 
;;; pregunta anterior sobre el modo de generación de la línea divisoria, 
;;; dicho punto tiene que residir o bien sobre la polilínea o bien fuera 
;;; de ella, nunca dentro de la superficie delimitada a dividir. 
;;; 
;;; 2. Al indicar el punto sobre la porción en donde se obtendrá el área 
;;; deseada, habrá que señalarlo DENTRO de dicha porción y ALEJADA de la 
;;; línea de división tanto como sea posible, de forma que ese punto no 
;;; llegue a quedar fuera de la porción que se va obteniendo a medida que 
;;; la línea divisoria se mueve durante su proceso de cálculo. 
;;; 
;;; 3. Finalmente usted tendrá que indicar exactamente de la misma manera 
;;; un punto de la porción restante: DENTRO de ella y ALEJADA de la línea 
;;; de división. 
;;; 
;;; Si se desea mayor precisión de cálculo en la división del área, se 
;;; pueden AUMENTAR el valor de las variable local: STEP 
;;; 
;;;******************LA UTILIDAD COMIENZA AQUI*************************** 

(defun PRERR (S)
 (if (/= S "Function cancelled") (princ (strcat "\nError: " S)))
 (setq *error* OLDERR)
 (princ))

(defun C:DVA (/
   OSM    STRPF    STRDC    EX    STEP    ARXSET    ARX    ARXON
   K    OK    D    P1    P2    PTS    PTB    DELN    AR    PAR
   TEM    PJ1    PJ2    PJ1X    PJ2X    PJ1Y    PJ2Y    DISX
   DISY    PJN    PTSS    PTBB    DIST    DELNJ    DELN1    LINEAD)
 (setvar "osmode" 0)
 (setvar "cmdecho" 0)
[color=blue]  (setq vcs 1) (setq k 1)[/color]
 (setq OLDERR *error*
   *error* PRERR
   OSM (getvar "osmode")
   STEP 10
   EX 0
   ARXSET (entsel
     "\nSeleccione una LWPOLYLINE cerrada como perímetro del área a dividir: ")
   ARX (entget (car ARXSET))
   ARXON (cdr (assoc -1 ARX)))
 (if (not
     (and (equal (cdr (assoc 0 ARX)) "LWPOLYLINE") (= (cdr (assoc 70 ARX)) 1)))
   (progn
     (princ "\nDISCULPE, SOLO SE PERMITEN LWPOLYLINES CERRADAS...")
     (setq EX 1)))
 (if (= EX 0)
   (progn
     (command "_undo" "m" "_layer" "m" "Area_Division" "" "_area" "e" ARXON)
     (setq AR (getvar "area"))
     (initget "Divide Cut")
     (setq STRDC (getkword
         "\nDIVIDE por número de partes o [CORTA una superficie conocida]? (D/C): "))
     (if (= STRDC "Divide")
       (setq K (getreal "\nIntroduzca número por el que dividir el total: ")
         TEM (/ AR K)))
     (if (= STRDC "Cut")
      [color=blue] (progn
       (setq vcs 0)[/color]
       (setq TEM (getreal "\nIntroduzca el área a cortar del total (m2): "))
       [color=blue])[/color]
     )
     (initget "Parallel Fixed")
     (setq STRPF (getkword
         "\nLínea de corte PARALELA a una dirección o [por un polo FIJO]? (P/F) :"))
     (if (= STRPF "Fixed") (FIXPT))
     (if (= STRPF "Parallel") (PARPT))))
 (setq *error* OLDERR)
 (setvar "osmode" OSM)
 (setvar "cmdecho" 1)
 (setvar "blipmode" 0))
;******************************************************************************
(defun FIXPT ()
[color=blue]  (LINEA)[/color]
 (setvar "osmode" OSM)
 (setvar "osmode" 0)
 (command "_line" P1 P2 "")
 (setq DELN (entlast)
   PTS (getpoint
     "\nEscoja un punto DENTRO de la porción a obtener y ALEJADO de la línea divisoria: ")
   PTB (getpoint
     "\nEscoja cualquier punto del RESTO del área y ALEJADO de la línea divisoria: "))
 (setvar "blipmode" 0)
 (princ "\nPor favor, espere...")
 (setq PTSS PTS PTBB PTB)
 (command "_boundary" PTS "" "_area" "e" "l")
 (setq PAR (getvar "area") OK (if (< PAR TEM) 1 (if (> PAR TEM) -1 0)))
 (progn
   (while (/= OK 0) (SUPERIORF) (INFERIORF))
   (entdel DELN))
 (command
   "_change" "l" "" "p" "c" "green" ""
   "_boundary" PTBB ""
   "_change" "l" "" "p" "c" "red" ""))
;******************************************************************************
(defun SUPERIORF ()
 (if (= OK 1)
   (progn
     (entdel (entlast))
     (setq PJ2 PTB
       PJ1 (inters P1 P2 PTS PTB)
       PJ1X (car PJ1)
       PJ2X (car PJ2)
       PJ1Y (cadr PJ1)
       PJ2Y (cadr PJ2)
       DISX (/ (+ PJ1X PJ2X) 2)
       DISY (/ (+ PJ1Y PJ2Y) 2)
       PJN (list DISX DISY))
     (command
       "_rotate" DELN "" P1 "r" P1 P2 PJN
       "_boundary" PTSS ""
       "_area" "e" "l")
     (setq OK (if (> (getvar "area") TEM) -1 1) PTS PJ1 PTB PJ2 P2 PJN)
     (if (= (rtos (getvar "area") 2 STEP) (rtos TEM 2 STEP)) (setq OK 0))
     (setq PAR (getvar "area")))))
;******************************************************************************            
(defun INFERIORF ()
 (if (= OK -1)
   (progn
     (entdel (entlast))
     (setq PJ2 PTS
       PJ1 (inters P1 P2 PTS PTB)
       PJ1X (car PJ1)
       PJ2X (car PJ2)
       PJ1Y (cadr PJ1)
       PJ2Y (cadr PJ2)
       DISX (/ (+ PJ1X PJ2X) 2)
       DISY (/ (+ PJ1Y PJ2Y) 2)
       PJN (list DISX DISY))
     (command
       "_rotate" DELN "" P1 "r" P1 P2 PJN
       "_boundary" PTSS ""
       "_area" "e" "l")
     (setq OK (if (< (getvar "area") TEM) 1 -1) PTS PJ2 PTB PJ1 P2 PJN)
     (if (= (rtos (getvar "area") 2 STEP) (rtos TEM 2 STEP)) (setq OK 0))
     (setq PAR (getvar "area")))))
;******************************************************************************
(defun PARPT ()
[color=blue]  (while (< vcs k)
 (LINEA)[/color]
 (setvar "osmode" OSM)
 (setvar "osmode" 0)
 (command "_line" P1 P2 "")
 (setq DELN (entlast)
   PTS (getpoint
     "\nEscoja un punto DENTRO de la porción a obtener y ALEJADO de la línea divisoria: ")
   PTB (getpoint
     "\nEscoja cualquier punto del RESTO del área y ALEJADO de la línea divisoria: "))
 (setvar "blipmode" 0)
 (princ "\nPor favor, espere...")
 (setq PTSS PTS PTBB PTB)
 (command "_boundary" PTS "" "_area" "e" "l")
 (setq PAR (getvar "area") OK (if (< PAR TEM) 1 (if (> PAR TEM) -1 0)))
 (progn
   (while (/= OK 0) (SUPERIORP) (INFERIORP))
   (entdel DELN))
 (command
   "_change" "l" "" "p" "c" "green" ""
   "_boundary" PTBB ""
   "_change" "l" "" "p" "c" "red" "")
[color=blue]  (setq vcs (+ vcs 1))
 )[/color]
)
;******************************************************************************
(defun SUPERIORP ()
 (if (= OK 1)
   (progn
     (entdel (entlast))
     (setq PJ2 PTB
       PJ1 (inters P1 P2 PTS PTB)
       PJ1X (car PJ1)
       PJ2X (car PJ2)
       PJ1Y (cadr PJ1)
       PJ2Y (cadr PJ2)
       DISX (/ (+ PJ1X PJ2X) 2)
       DISY (/ (+ PJ1Y PJ2Y) 2)
       PJN (list DISX DISY)
       DIST (distance PJ1 PJN))
     (command "_offset" DIST DELN PTBB "")
     (entdel DELN)
     (setq DELN (entlast))
     (command "_boundary" PTSS "" "_area" "e" "l")
     (setq OK (if (> (getvar "area") TEM) -1 1) PTS PJ1 PTB PJ2 P2 PJN)
     (if (= (rtos (getvar "area") 2 STEP) (rtos TEM 2 STEP)) (setq OK 0))
     (setq PAR (getvar "area")))))
;******************************************************************************
(defun INFERIORP ()
 (if (= OK -1)
   (progn
     (entdel (entlast))
     (setq PJ2 PTS
       PJ1 (inters P1 P2 PTS PTB)
       PJ1X (car PJ1)
       PJ2X (car PJ2)
       PJ1Y (cadr PJ1)
       PJ2Y (cadr PJ2)
       DISX (/ (+ PJ1X PJ2X) 2)
       DISY (/ (+ PJ1Y PJ2Y) 2)
       PJN (list DISX DISY)
       DIST (distance PJ1 PJN))
     (command "_offset" DIST DELN PTSS "")
     (entdel DELN)
     (setq DELN (entlast))
     (command "_boundary" PTSS "" "_area" "e" "l")
     (setq OK (if (< (getvar "area") TEM) 1 -1) PTS PJ2 PTB PJ1 P2 PJN)
     (if (= (rtos (getvar "area") 2 STEP) (rtos TEM 2 STEP)) (setq OK 0))
     (setq PAR (getvar "area")))))
;******************************************************************************
[color=blue](defun LINEA ()
 (setq p1 (getpoint "\primer punto de la linea:"))
 (setq p2 (getpoint p1 "\segundo punto de la linea:"))
)[/color]

September 5, 2018

Good day to everyone.
I hope the author of this Lisp does not bother me.
I have added a couple of lines to the code to work bette

;;; DIVAREA.LSP Land division utility 
;;; written by Yorgos Angelopoulos 
;;; aggior@panafonet.gr 
;;; ------------------------------------ 
;;; Traducción del código original al español, por Miguel A. Lázaro Marín 
;;; http://perso.wanadoo.es/lm2ark 
;;; ------------------------------------ 
;;; Citando al autor original, Sr. Angelopoulos, y su posterior traductor 
;;; al Sr. Lázaro Marín  he planteado una variante al programa en la cual 
;;; si la solución es convergente, la va a encontrar con mayor velocidad 
;;; que la rutina original. Lea atentamente las instrucciones, en las que 
;;; hubo sutiles cambios
;;; por ,   Julio C. Jaramillo      j_julio@hotmail.com
;;; ------------------------------------ 
;;; ------------------------------------ 
;;; Espero que el autor de este codigo no se moleste conmigo. Le he agregado
;;; un par de líneas a este lisp. 
;;; José Hernández           josehernandezd@gmail.com
;;; ------------------------------------
;;; ------------------------------------
;;; Suponga que usted tiene que dividir una parcela grande de terreno entre 
;;; 2, 3, 4,...(¡o incluso dividirla entre 5.014!); o bien se desea cortar 
;;; una porción de 2345 m2 para segregarla de la parcela matriz u original. 
;;; 
;;; Todo lo que usted necesita es tener dibujada una "polilínea optimizada" 
;;; (entidad "LWPOLYLINE", incluída en AutoCAD a partir de su versión 14), 
;;; que se encuentre CERRADA y que coincida con el perímetro del área total 
;;; de la parcela a dividir. También una LÍNEA de DIVISIÓN en la cual comienza
;;; a iterar este rutina.
;;; 
;;; Cargue la utilidad, después de ponerla en un directorio apropiado, por 
;;; ejemplo el C:\Archivos de programa\AutoCAD\Support, bien sea 
;;; invocando el comando _APPLOAD o bien mediante (LOAD "DIVAREA"), y tras 
;;; la pertinente carga ejecutémosla escribiendo DIVAREA en la línea de 
;;; comandos. 
;;; 
;;; Conteste a las escasas preguntas que la rutina le irá formulando y 
;;; RECUERDE: 
;;; 
;;; Cuando le sea solicitado que SELECCIONE la línea de 
;;; división aproximada inicial, tenga presente lo siguiente: 
;;; 
;;; 1. Esta LÍNEA de DIVISIÓN será trasladada (en paralelo a la inicial) 
;;; o rotada (en función de la opción elegida) durante la ejecución de la 
;;; rutina, de manera que sus puntos inicial y final que definen la misma 
;;; deben marcarse teniendo en cuenta que, durante las aludidas traslación
;;; o rotación, no vayan a pasar hacia el interior del contorno definido 
;;; por la LWPLYLINE (aunque debe resultar fácil superar este inconveniente).
;;; Por tanto se aconseja que los puntos que definen LÍNEA de DIVISIÓN 
;;; inicial estén tan LEJANOS HACIA FUERA del perímetro como sea posible 
;;; sin exceder, por supuesto, el área actual visible de pantalla. 
;;; 
;;; En cuanto al punto o polo FIJO, en caso de que se haya preferido la 
;;; opción "F" en lugar de "P" (dirección PARALELA) como respuesta a la 
;;; pregunta anterior sobre el modo de generación de la línea divisoria, 
;;; dicho punto tiene que residir o bien sobre la polilínea o bien fuera 
;;; de ella, nunca dentro de la superficie delimitada a dividir. 
;;; 
;;; 2. Al indicar el punto sobre la porción en donde se obtendrá el área 
;;; deseada, habrá que señalarlo DENTRO de dicha porción y ALEJADA de la 
;;; línea de división tanto como sea posible, de forma que ese punto no 
;;; llegue a quedar fuera de la porción que se va obteniendo a medida que 
;;; la línea divisoria se mueve durante su proceso de cálculo. 
;;; 
;;; 3. Finalmente usted tendrá que indicar exactamente de la misma manera 
;;; un punto de la porción restante: DENTRO de ella y ALEJADA de la línea 
;;; de división. 
;;; 
;;; Si se desea mayor precisión de cálculo en la división del área, se 
;;; pueden AUMENTAR el valor de las variable local: STEP 
;;; 
;;;******************LA UTILIDAD COMIENZA AQUI*************************** 

(defun PRERR (S)
  (if (/= S "Function cancelled") (princ (strcat "\nError: " S)))
  (setq *error* OLDERR)
  (princ))

(defun C:DIVAREA (/
    OSM    STRPF    STRDC    EX    STEP    ARXSET    ARX    ARXON
    K    OK    D    P1    P2    PTS    PTB    DELN    AR    PAR
    TEM    PJ1    PJ2    PJ1X    PJ2X    PJ1Y    PJ2Y    DISX
    DISY    PJN    PTSS    PTBB    DIST    DELNJ    DELN1    LINEAD
    vcs)
  (vl-load-com)
  (setvar "cmdecho" 0)
  (setq OLDERR *error*
    *error* PRERR
    OSM (getvar "osmode")
  )

  (command "layer" "m" "Area" "c" "3" "" "")
  (command "_-STYLE" "Romans" "romans.shx" 0  1  0 "NO" "NO" "")
;-------------------------------------------------------
  (setq dsc (getvar "dimscale"))
  (setq ht (* 0.18 dsc))
;-------------------------------------------------------

  (setq ptt (getpoint "\nPique dentro de un area cerrada "))
  (command "-boundary" "a" "i" "n" "" "" ptt "")
  (setq pl (entlast))
  (setq poly (listpol pl))
  (setq int (centroid poly))
  (command "_area" "o" pl)
  (command "_erase" pl "")
  (setq AR (getvar "area")) (setq art AR)
  (setvar "clayer" "Area")
  (command "text" "j" "c" int ht "90" (strcat (rtos art 2 2) "m²"))
  (princ "\nArea Total ") (princ (rtos art 2 2)) (princ "\m²")
  (setq vcs 1) (setq k 1)
  (setq STEP 10)
  (setq EX 0)
;------------------------------------------------------------------------------
  (if (= EX 0)
    (progn
      (command "_undo" "m" "_layer" "m" "Area_Division" "" "_area" "e" ARXON)
      (initget "Divide Cut")
      (setq STRDC (getkword
          "\nDIVIDE por número de partes o [CORTA una superficie conocida]? (D/C): "))
      (if (= STRDC "Divide")
        (setq K (getreal "\nIntroduzca número por el que dividir el total: ")
          TEM (/ AR K)))
      (if (= STRDC "Cut")
        (progn
        (setq vcs 0)
        (setq TEM (getreal "\nIntroduzca el área a cortar del total (m2): "))
        ;(setq k (getreal "\nIntroduzca número por el que dividir el total: "))
        )
      )
      (initget "Parallel Fixed")
      (setq STRPF (getkword
          "\nLínea de corte PARALELA a una dirección o [por un polo FIJO]? (P/F) :"))
      (if (= STRPF "Fixed") (FIXPT))
      (if (= STRPF "Parallel") (PARPT))))
  (setq *error* OLDERR)
  (setvar "osmode" OSM)
  (setvar "cmdecho" 1)
  (setvar "blipmode" 0))
  (setvar "clayer" "0")
;******************************************************************************
(defun FIXPT ()
  (while (and (< vcs k) (not (= TEM nil)))
  (LNA)
  (setvar "osmode" OSM)
  (setvar "osmode" 0)
  (command "_line" P1 P2 "")
  (setq DELN (entlast)
    PTS (getpoint
      "\nEscoja un punto DENTRO de la porción a obtener y ALEJADO de la línea divisoria: ")
    PTB (getpoint
      "\nEscoja cualquier punto del RESTO del área y ALEJADO de la línea divisoria: "))
  (setvar "blipmode" 0)
  (princ "\nPor favor, espere...")
  (setq PTSS PTS PTBB PTB)
  (command "_boundary" PTS "" "_area" "e" "l")
  (setq PAR (getvar "area") OK (if (< PAR TEM) 1 (if (> PAR TEM) -1 0)))
  (progn
    (while (/= OK 0) (SUPERIORF) (INFERIORF))
    (entdel DELN))
  (command
    "_change" "l" "" "p" "c" "green" ""
    "_boundary" PTBB ""
    "_change" "l" "" "p" "c" "red" "")
  (setq vcs (+ vcs 1))
  (if (= STRDC "Cut")
      (progn
        (setq vcs (- vcs 1))
        (setq art (- art TEM))
        (princ "\nQuedan : ")
        (princ art)
      (setq TEM (getreal "\nIntroduzca el área a cortar del total (m2): "))
      (if (> TEM art) 
          (setq vcs k)
      )
      )
  )
  )
  (setvar "clayer" "0")
)
;******************************************************************************
(defun SUPERIORF ()
  (if (= OK 1)
    (progn
      (entdel (entlast))
      (setq PJ2 PTB
        PJ1 (inters P1 P2 PTS PTB)
        PJ1X (car PJ1)
        PJ2X (car PJ2)
        PJ1Y (cadr PJ1)
        PJ2Y (cadr PJ2)
        DISX (/ (+ PJ1X PJ2X) 2)
        DISY (/ (+ PJ1Y PJ2Y) 2)
        PJN (list DISX DISY))
      (command
        "_rotate" DELN "" P1 "r" P1 P2 PJN
        "_boundary" PTSS ""
        "_area" "e" "l")
      (setq OK (if (> (getvar "area") TEM) -1 1) PTS PJ1 PTB PJ2 P2 PJN)
      (if (= (rtos (getvar "area") 2 STEP) (rtos TEM 2 STEP)) (setq OK 0))
      (setq PAR (getvar "area")))))
;******************************************************************************            
(defun INFERIORF ()
  (if (= OK -1)
    (progn
      (entdel (entlast))
      (setq PJ2 PTS
        PJ1 (inters P1 P2 PTS PTB)
        PJ1X (car PJ1)
        PJ2X (car PJ2)
        PJ1Y (cadr PJ1)
        PJ2Y (cadr PJ2)
        DISX (/ (+ PJ1X PJ2X) 2)
        DISY (/ (+ PJ1Y PJ2Y) 2)
        PJN (list DISX DISY))
      (command
        "_rotate" DELN "" P1 "r" P1 P2 PJN
        "_boundary" PTSS ""
        "_area" "e" "l")
      (setq OK (if (< (getvar "area") TEM) 1 -1) PTS PJ2 PTB PJ1 P2 PJN)
      (if (= (rtos (getvar "area") 2 STEP) (rtos TEM 2 STEP)) (setq OK 0))
      (setq PAR (getvar "area")))))
;******************************************************************************
(defun PARPT ()
  (while (and (< vcs k) (not (= TEM nil)))
  (LNA)
  (setvar "osmode" OSM)
  (setvar "osmode" 0)
  (command "_line" P1 P2 "")
  (setq DELN (entlast)
    PTS (getpoint
      "\nEscoja un punto DENTRO de la porción a obtener y ALEJADO de la línea divisoria: ")
    PTB (getpoint
      "\nEscoja cualquier punto del RESTO del área y ALEJADO de la línea divisoria: "))
  (setvar "blipmode" 0)
  (princ "\nPor favor, espere...")
  (setq PTSS PTS PTBB PTB)
  (command "_boundary" PTS "" "_area" "e" "l")
  (setq PAR (getvar "area") OK (if (< PAR TEM) 1 (if (> PAR TEM) -1 0)))
  (progn
    (while (/= OK 0) (SUPERIORP) (INFERIORP))
    (entdel DELN))
  (command
    "_change" "l" "" "p" "c" "green" ""
    "_boundary" PTBB ""
    "_change" "l" "" "p" "c" "red" "")
  (setq vcs (+ vcs 1))
  (if (= STRDC "Cut")
      (progn
        (setq vcs (- vcs 1))
        (setq art (- art TEM))
        (princ "\nQuedan : ")
        (princ art)
      (setq TEM (getreal "\nIntroduzca el área a cortar del total (m2): "))
      (if (> TEM art) 
          (setq vcs k)
      ) 
      )
  )
  )
  (setvar "clayer" "0")
)
;******************************************************************************
(defun SUPERIORP ()
  (if (= OK 1)
    (progn
      (entdel (entlast))
      (setq PJ2 PTB
        PJ1 (inters P1 P2 PTS PTB)
        PJ1X (car PJ1)
        PJ2X (car PJ2)
        PJ1Y (cadr PJ1)
        PJ2Y (cadr PJ2)
        DISX (/ (+ PJ1X PJ2X) 2)
        DISY (/ (+ PJ1Y PJ2Y) 2)
        PJN (list DISX DISY)
        DIST (distance PJ1 PJN))
      (command "_offset" DIST DELN PTBB "")
      (entdel DELN)
      (setq DELN (entlast))
      (command "_boundary" PTSS "" "_area" "e" "l")
      (setq OK (if (> (getvar "area") TEM) -1 1) PTS PJ1 PTB PJ2 P2 PJN)
      (if (= (rtos (getvar "area") 2 STEP) (rtos TEM 2 STEP)) (setq OK 0))
      (setq PAR (getvar "area")))))
;******************************************************************************
(defun INFERIORP ()
  (if (= OK -1)
    (progn
      (entdel (entlast))
      (setq PJ2 PTS
        PJ1 (inters P1 P2 PTS PTB)
        PJ1X (car PJ1)
        PJ2X (car PJ2)
        PJ1Y (cadr PJ1)
        PJ2Y (cadr PJ2)
        DISX (/ (+ PJ1X PJ2X) 2)
        DISY (/ (+ PJ1Y PJ2Y) 2)
        PJN (list DISX DISY)
        DIST (distance PJ1 PJN))
      (command "_offset" DIST DELN PTSS "")
      (entdel DELN)
      (setq DELN (entlast))
      (command "_boundary" PTSS "" "_area" "e" "l")
      (setq OK (if (< (getvar "area") TEM) 1 -1) PTS PJ2 PTB PJ1 P2 PJN)
      (if (= (rtos (getvar "area") 2 STEP) (rtos TEM 2 STEP)) (setq OK 0))
      (setq PAR (getvar "area")))))
;******************************************************************************
(defun LNA ()
  (princ)
  (setvar "osmode" 8200)
  (setq p1 (getpoint "\nPrimer punto de la linea:"))
  (setq p2 (getpoint p1 "\nSegundo punto de la linea:"))
)
;******************************************************************************
(defun centroid (poly / n)
    (setq n (length poly))    
    (mapcar '(lambda (a) (/ a n)) (apply 'mapcar (cons '+ poly)))
)
;******************************************************************************
(defun listpol	(pl / pa pt lst)
  (vl-load-com)
  (setq	pa (if (vlax-curve-IsClosed pl)
	      (vlax-curve-getEndParam pl)
	      (1+ (vlax-curve-getEndParam pl))
	   )
  )
  (while (setq pt (vlax-curve-getPointAtParam pl (setq pa (1- pa))))
    (setq lst (cons (trans pt 0 1 ) lst))
  )
)
;*******************************************************************************

Divarea.lsp

November 27, 2019

Hi .I know that this post is old but i need to ask if someone can update the code and add and extra optionto divide into 2 or more parts with a user line option
like this

Thanks

Edited November 27, 2019 by prodromosm

Sign In

Area split equal.

Recommended Posts

Guest

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

José1534592609

Posted Images

marko_ribar

CafeJr

marko_ribar

CafeJr

Guest

EFL

EFL

Trmsa

Trmsa

CafeJr

xxfaxx

EFL

xxfaxx

José1534592609

SLW210

BIGAL

José1534592609

José1534592609

Guest

Join the conversation

José1534592609

Tutorials

Forums

Activity