切割面积
我需要有人谁可以使这个cad lisp切割面积从一大片土地。。我正在寻找并厌倦了手动计算一部分土地。这是我的样品。。
http://img11.imageshack.us/img11/7654/cuttingarea.jpg 思维过程是什么；
-给定一块土地，可以是任何不规则形状
-需要根据已知目标区域切除一部分
-切割线始终与用户选择的一侧平行？
Q
-地块始终是闭合多段线还是由直线组成。 我对伪代码的思考。。。
选择“外部边界”，然后选择“平行线”。
然后，不知何故，从选定的线和它与主多段线相交的地方形成一条闭合的多段线。。。可能很难找到从哪一边得到面积。。。可能需要用户的另一个选择。
最后，使用AREA命令查找区域。。
是的，地块是多段线。。。
这是另一块土地样本。。
http://img6.imageshack.us/img6/883/cuttingarea2.jpg
这个有很多点或角点，所以我需要时间来计算。。
希望有一天能帮助解决这个问题。
非常感谢。
奥利弗 你能不能在平行线的交点处打断外基线，使其成为闭合基线，然后只使用“面积”命令？
或者这就是你一直在做的事情？ 耶。。之前，我通过从参考线或基线偏移并调整20x来手动完成。。
你说试试区域指挥。。我一直都在这么做，但没什么能成功。。它只是加和减。。
奥利弗 哦gr8t。。我发现了一个常规的Lisp程序。
;;;DIVAREA.LSPLand 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
stp0.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
干杯
奥利弗 您也可以尝试：
http://cadtips.cadalyst.com/2d-editing/subdivide-lot-desired-areas-equal-or-unequal 也许是这个？
;;;=======================================================
;;;=======================================================
;;;
;;;FUNCTION: Area Division (AreaDiv.lsp)
;;;Calculates the area of a partitioned region.
;;;
;;;AUTHOR
;;;Copyright © 2009 Lee McDonnell
;;; (contact ~ Lee Mac, CADTutor.net)
;;;
;;;VERSION
;;;1.0~23.03.2009
;;;
;;;=======================================================
;;;=======================================================
(defun c:ADiv(/ *error* vlst ovar spc cEnt vpt cCur
cAng clen grlist arpt spt pt1 pt2 iLin
iArr iLst ptLst plst stpar vpts aPly)
(vl-load-com)
(defun *error*(msg)
(grtext) (redraw)
(if ovar (mapcar 'setvar vlst ovar))
(if (not (member msg '("Function cancelled" "quit / exit abort")))
(princ (strcat "\n<!> Error: " (strcase msg) " <!>")))
(princ))
(setq vlst '("CMDECHO" "OSMODE")
ovar (mapcar 'getvar vlst))
(mapcar 'setvar vlst '(0 0))
(setq spc (vla-get-ModelSpace
(vla-get-ActiveDocument
(vlax-get-Acad-Object))))
(if (and (setq cEnt (entsel "\nSelect Edge for Segregation: "))
(eq "LWPOLYLINE" (cdadr (entget (car cEnt)))))
(progn
(setq vpt (osnap (cadr cEnt) "_nea")
cCur (vlax-ename->vla-object (car cEnt))
cAng (angle '(0 0 0) (vlax-curve-getFirstDeriv cCur
(vlax-curve-getParamAtPoint cCur vpt))))
(setq clen (distance (vlax-curve-getPointatParam cCur
(fix (vlax-curve-getParamAtPoint cCur vpt)))
(vlax-curve-getPointatParam cCur
(1+ (fix (vlax-curve-getParamAtPoint cCur vpt))))))
(grtext -1 "Select Area Segregation...")
(while (= 5 (car (setq grlist (grread t 1))))
(redraw)
(if (= 'list (type (setq arpt (cadr grlist))))
(progn
(setq spt (vlax-curve-getClosestPointto cCur arpt)
pt1 (polar spt cAng (/ clen 3.0))
pt2 (polar spt cAng (/ clen -3.0)))
(grdraw pt1 pt2 3))))
(setq iLin (vla-Addline spc (vlax-3D-point spt)
(vlax-3D-point (polar spt cAng clen)))
iArr (vlax-variant-value
(vla-IntersectWith iLin cCur acExtendThisEntity)))
(if (> (vlax-safearray-get-u-bound iArr 1) 0)
(progn
(setq iLst (vlax-safearray->list iArr))
(while (not (zerop (length iLst)))
(setq ptLst (cons (list (car iLst) (cadr iLst) (caddr iLst)) ptLst)
iLst (cdddr iLst)))
(and (vla-delete iLin) (setq iLin nil))
(if (> (length ptlst) 1)
(progn
(setq plst(vl-sort (list (vlax-curve-getParamAtPoint cCur (car ptLst))
(vlax-curve-getParamAtPoint cCur (cadr ptLst))) '<)
stpar (1+ (fix (car plst))))
(while (< stpar (cadr plst))
(setq plst (append plst (list stpar))
stpar (1+ stpar)))
(setq plst (vl-sort plst '<)
vpts (mapcar '(lambda (p) (vlax-curve-getPointatParam cCur p)) plst))
(command "_pline") (foreach x vpts (command x)) (command "_C")
(vla-put-color (setq aPly (vlax-ename->vla-object (entlast))) acRed)
(princ (strcat "\n<<<Area of Enclosed Region: " (rtos (vla-get-Area aPly)) " >>>")))
(princ "\n<!> Selected Segregation not Closed <!>")))
(princ "\n<!> Area Not Segregated Properly <!>")))
(princ "\n<!> Nothing Selected or this isn't an LWPLINE <!>"))
(mapcar 'setvar vlst ovar)
(grtext) (redraw)
(princ))
(princ "\n** AreaDiv.lsp Successfully Loaded - type \"ADiv\" to invoke **") (princ)
谢谢你的努力。。我想你错过了什么。。我没有看到需要任何目标区域
奥利弗
页:
[1]
2