Jump to content

CafeJr

Recommended Posts

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.

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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...

 

Divided area.jpg

Link to comment
Share on other sites

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...

Link to comment
Share on other sites

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:

 

Divarea printscreen.jpg

Link to comment
Share on other sites

  • 2 months later...

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

Link to comment
Share on other sites

  • 2 years later...

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?

Link to comment
Share on other sites

  • 1 year later...

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

Link to comment
Share on other sites

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

Link to comment
Share on other sites

  • 1 month later...
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!... :thumbsup:...

Link to comment
Share on other sites

  • 1 year later...

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

Link to comment
Share on other sites

  • 3 months later...

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 by SLW210
Fixed Code Tags.
Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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]

Link to comment
Share on other sites

  • 3 weeks later...
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

  • Like 1
Link to comment
Share on other sites

  • 1 year later...

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

split2ureg.gif

 

Thanks

Edited by prodromosm
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...