;;; Cut & Fill by ymg ;
;;; ;
;;; Will return incorrect results if polyline are self-crossing. ;
(defun c:cf
(/ *acaddoc
* ar cutcol cw cwi dm1 dm2 dp11 dp12 dp21 dp22 fillcol
fuzz hatchcol i intl objpol1 objpol2 p p1 p2 pm0 pm1 pm2 pol1
pol2 ss1 ss2 totcut totfill txt txtlayer valid varl)
(command "layer" "off" "PR-GRID" "") (command "layer" "off" "PR-GRID-MIN" "") )
)
(setq varl '
("OSMODE" "CMDECHO" "DIMZIN") )
)
(setq cutcol
10 fillcol
94 ; Cut is Red, Fill is Green ; totcut 0 totfill 0 ; Total Cut and Total Fill ;
txtlayer "FC-TEXT" ; Name of Layer for Cut and Fill Values ;
)
(princ "\nSelect Reference Polyline:") (princ "\nYou Must Select a Polyline:") )
(princ "\nSelect Proposed Polyline:") (princ "\nYou Must Select a Polyline:") )
cw
(if (iscw_p
(listpol pol1
)) 1 -1) )
; Getting all the intersections between poly. ;
(setq intl
(intersections objpol1 objpol2
))
; If polyline is closed add first Intersection to end of list ;
)
; Insure that Intersection List goes same direction as Reference Polyline. ;
(setq cwi
(if (iscw_p intl
) 1 -1))
dp11 (getdistoncurve pol1 p1)
dp21 (getdistoncurve pol2 p1)
i 1
)
dp12 (getdistoncurve pol1 p2)
dp22 (getdistoncurve pol2 p2)
dm1 (/ (+ dp11 dp12) 2)
dm2 (/ (+ dp21 dp22) 2)
pm1 (getptoncurve pol1 dm1)
pm2 (getptoncurve pol2 dm2)
pm0
(mapcar '
/ (mapcar '
+ pm1 pm2
) '
(2.
2.
)) ; Internal Point ; )
(setq totcut
(+ totcut ar
) hatchcol cutcol
) (setq totfill
(+ totfill ar
) hatchcol fillcol
) )
;(vl-cmdf "._POINT" pm0 "")
(vl-cmdf "._-HATCH" "_P" "SOLID""_CO" hatchcol pm0
"")
)
)
dp11 dp12
dp21 dp22
)
)
txt
(strcat "{\\C94;Fill: " (rtos totfill
2 2) " m2\\P\\C10;Cut: " (rtos totcut
2 2) " m2}") )
(cons 7 "TopoCAD") ; text style )
)
(command "layer" "on" "PR-GRID" "") (command "layer" "on" "PR-GRID-MIN" "") )
(Alert "Not Enough Intersections To Process !") )
(*error* nil)
)
(princ "\nCalculates Cut & Fill Between Two Intersecting Polylines") (princ "\nCF to start...")
; onside by ymg ;
; Negative return, point is on right of v1->v2 ;
; Positive return, point is on left of v1->v2 ;
; 0 return, point is smack on the vector. ;
; ;
(defun onside
(p v1 v2
/ x y
) (- (* (- (car v1
) x
) (- (cadr v2
) y
)) (* (- (cadr v1
) y
) (- (car v2
) x
))) )
; is the polyline clockwise. by LeeMac ;
)
)
)
)
)
;;****************************************************************************;
;; Return list of intersection(s) between two objects ;
;; obj1 - first VLA-Object ;
;; obj2 - second VLA-Object ;
;; mode - intersection mode (acExtendNone acExtendThisEntity ;
;; acExtendOtherEntity acExtendBoth) ;
;;****************************************************************************;
(defun Intersections
(obj1 obj2
) (tupl3
(vlax-invoke obj1 'intersectwith obj2 acExtendNone
)) )
(defun getdistoncurve
(e p
) )
)
)
(defun getptoncurve
(e d
) )
;;; listpol by Gille Chanteau ;
;;; Returns the vertices list of any type of polyline (WCS coordinates) ;
;;; ;
;;; Argument ;
;;; en, a polyline (ename or vla-object) ;
(defun listpol
(en
/ i p l
) )
)