المشاركة الأصلية بواسطة aymanahmed مشاهدة المشاركة
أعتقد أن هذا هو ماتحتاجونه

كود:
;;;DIVAREA.LSP Land division utility
;;; 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