- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
;;;DIVAREA.LSP Land division utility
;;; written by Yorgos Angelopoulos
;;; aggior@panafonet.gr
;;;
;;; Suppose that you have to split a big part into 2, 3, 4 (or even 5.014!)
;;; or you want to cut a part of 2345 m2 out of the big one.
;;;
;;; All you need is a CLOSED LWPOLYLINE enclosing the big 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 typing DIVAREA.
;;;
;;; Answer the few questions you will be asked and REMEMBER:
;;;
;;; When you are prompted to indicate the two points of
;;; the approximate division line, please bear in mind that
;;;
;;; 1. This DIVISION LINE will be rotated (or be offseted) and
;;; neither of its endpoints should reside outside of the boundary,
;;; (although it should have been easy to overcome this bug),
;;; so pick points as FAR OUT from the boundary as possible,
;;; not exceeding, of course, your current visibe area.
;;; As for the FIXED POINT, in case you prefer "F"
;;; rather than "C" as an answer in the previous question, it has to
;;; reside on the lwpoly or outside of it, never inside.
;;;
;;; 2. When indicating point into the part which will obtain the desired
;;; area, you have to indicate INTO it 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 into it.
;;;
;;; 3. Finally, you have to indicate exactly by the same way,
;;; FAR FROM DIVISION line and INTO the remaining piece.
;;; If you prefer more precision you can decrease local vars step2
;;; and step1 accordingly.
;;;
;;;******************UTILITY STARTS HERE*******************************
(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
stp 0.01
stp1 0.005
stp2 0.0005
)
(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)
(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" "")
)
;******************************************************************************
(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
Solved! Go to Solution.