;;; Cut & Fill by ymg ;
;;; ;
(defun c:cf
(/ ** *acdoc
* a are b bnd c cutcol d dir dl1 dl2 e fillcol hcol
intl len1 len2 p p0 p1 p2 pm pol1 pol2 sp1 sp2 spe ss1
ss2 totcut totfill txt txtlayer varl)
)
)
(setq varl '
("OSMODE" "CMDECHO" "DIMZIN" "PEDITACCEPT") )
(setq cutcol
1 fillcol
3 ; Cut is Red, Fill is Green ; totcut 0 totfill 0 ; Total Cut and Total Fill ;
txtlayer "Text" ; Name of Layer for Cut and Fill Values ;
)
ss1
(ssget "_+.:L:S" '
((0 .
"LWPOLYLINE"))) )
)
(princ "\nYou Must Select a Polyline:") )
ss2
(ssget "_+.:L:S" '
((0 .
"LWPOLYLINE"))) )
)
(princ "\nYou Must Select a Polyline:") )
(setq lst2
(listpol pol2
) )
)
dir
(if (< (/ pi
2) (angle sp1 spe
) (/ (* 3 pi
) 2)) -1 1) )
; Getting all the intersections between poly. ;
(setq intl
(intersections pol1 pol2
))
; Computing distance of intersections on each polyline ;
)
; If both polyline are closed add first Intersection to end of list ;
; We also add a distance to each distances list ;
dir
(if (iscw_p
(listpol pol1
)) -1 1) )
)
; Finding points at mid-distance between intersections on each polyline ;
; Calculating midpoint between mid-distance points to get an internal point;
; Creating a list of all these points plus the intersection points ;
(setq p1
(getptoncurve pol1
(rem (* (+ a b
) 0.5) len1
))) (setq p2
(getptoncurve pol2
(rem (* (+ c d
) 0.5) len2
))) )
p1 p2 e
)
)
dl1
(cdr dl1
) dl2
(cdr dl2
) intl
)
)
(setq p
(car i
) ; Midpoint between p1 p2 ; p0
(cadddr i
) ; Intersection Point ; p1
(cadr i
) ; Midpoint of Intersections on Reference Polyline ; p2
(caddr i
) ; Midpoint of Intersections on Proposed Polyline ; )
(if (> (abs (onside p2 p0 p1
)) 1e
-3
) ; Not Colinear ; )
(setq totfill
(+ totfill are
) hcol fillcol
) (setq totcut
(+ totcut are
) hcol cutcol
) )
(vl-cmdf "._-HATCH" "_CO" hcol
"." "_P" "SOLID" "_S" bnd
"" "") )
)
)
txt
(strcat "{\\C3;Fill: " (rtos totfill
2 2) " m2\\P\\C1;Cut: " (rtos totcut
2 2) " m2}") )
)
)
)
(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 left of v1->v2 ;
; Positive return, point is on right of v1->v2 ;
; 0 return, point is smack on the vector. ;
; ;
(defun onside
(p v1 v2
/ x y
) (- (* (- (cadr v1
) y
) (- (car v2
) x
)) (* (- (car v1
) x
) (- (cadr v2
) y
))) )
; ;
; Is Polyline Clockwise by LeeMac ;
; ;
; Argument: l, Point List ;
; Returns: t, Polyline is ClockWise ;
; nil, Polyline is CounterClockWise ;
; ;
)
)
)
)
)
;; ;
;; Return list of intersection(s) between two VLA-Object or two ENAME ;
;; obj1 - first VLA-Object ;
;; obj2 - second VLA-Object ;
;; mode - intersection mode (acExtendNone acExtendThisEntity ;
;; acExtendOtherEntity acExtendBoth) ;
;; Requires triplet ;
;; ;
(defun Intersections
(obj1 obj2
)
(triplet
(vlax-invoke obj1 'intersectwith obj2 acExtendNone
)) )
;; ;
;; triplet, Separates a list into triplets of items. ;
;; ;
)
(defun getdistoncurve
(e p
) )
)
)
(defun getptoncurve
(e d
) )
;; ;
;; listpol by ymg (Simplified a Routine by Gile Chanteau ;
;; ;
;; Parameter: en, Entity Name or Object Name of Any Type of Polyline ;
;; ;
;; Returns: List of Points in Current UCS ;
;; ;
;; Notes: On Closed Polyline the Last Vertex is Same as First) ;
;; ;
(defun listpol
(en
/ i l
) )
)
;; plineorg by (gile) (Modified into a function by ymg) ;
;; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/ ;
;; change-polyline-start-point/td-p/2154331 ;
;; ;
;; Function to modify origin of a closed polyline ;
;; ;
;; Arguments: ;
;; en : Ename or VLA-Object of a Closed Polyline. ;
;; pt : Point ;
;; ;
;; Returns: Point of Origin if successful, else nil. ;
;; ;
(defun plineorg
(en pt
/ blst d1 d2 d3 n norm obj pa plst
) (setq obj en en
(vlax
-vla
-object
->ename obj
)) )
;; bulgratio by (gile) ;
;; Returns a bulge which is proportional to a reference ;
;; Arguments : ;
;; b : the reference bulge ;
;; k : the ratio (between angles or arcs length) ;
(defun bulgratio
(b k
/ a
) (/ (sin (* k a
)) (cos (* k a
))) )
;; Sublist by (gile) ;
;; Returns a sublist similar to substr function. ;
;; lst : List from which sublist is to be extracted ;
;; idx : Index of Item at Start of sublist ;
;; len : Length of sublist or nil to return all items. ;
(defun sublist
(lst n len
/ rtn
) )
)
)
)
)
)
plst
(append (sublist plst
(* 2 n
) nil) (sublist plst 0 (* 2 n))
)
blst
(append (sublist blst n
nil) (sublist blst
0 n
)) )
d1 (- d3 d2)
(sublist plst (* 2 n) nil)
(sublist plst 0 (* 2 n))
)
(sublist blst n nil)
(list (bulgratio
(nth (1- n
) blst
) (/ d1 d3
))) )
)
)
)
)
nil
)
)