@mss_selcukuni a écrit :
@CADaSchtroumpf
if any line (or any shape) passing over the box which we select.. Code isnt including this pass over line in the calculation...
in complex drawings, we can meet situation like this..
Cant we including these lines?
pls see attachments..
Drawing 2 is basic sample..
Drawing 22 is more complex sample then drawing 2
@mss_selcukuni
Your request becomes complex...
If I was able to do anything with the "Drawing22.dwg", there are still problems.
I have treated only polylines. I manage to cut them at the limits of the box but the result in Excel is not always good.
The resulting lengths are allway correct, but the surfaces for the cut polylines are wrong.
For example in the "BOX 2" for the layer "Wall_Painting" and "Floor_Parquet" the original polyline will become two portions of distinct polylines whose surfaces will no longer mean anything.
You will have to resume these surfaces manually because I cannot solve this by programming (join the two portions by one or more segments in order to obtain a single polyline (closed or not: it does not matter) and to have the good area.
I hope this will still be able to help you because I for my part could not go further.
(vl-load-com)
(defun add_vtx (obj add_pt ent_name / bulg)
(vla-addVertex
obj
(1+ (fix add_pt))
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray vlax-vbdouble (cons 0 1))
(list
(car (trans (vlax-curve-getpointatparam obj add_pt) 0 ent_name))
(cadr (trans (vlax-curve-getpointatparam obj add_pt) 0 ent_name))
)
)
)
)
(setq bulg (vla-GetBulge obj (fix add_pt)))
(vla-SetBulge obj
(fix add_pt)
(/
(sin (/ (* 4 (atan bulg) (- add_pt (fix add_pt))) 4))
(cos (/ (* 4 (atan bulg) (- add_pt (fix add_pt))) 4))
)
)
(vla-SetBulge obj
(1+ (fix add_pt))
(/
(sin (/ (* 4 (atan bulg) (- (1+ (fix add_pt)) add_pt)) 4))
(cos (/ (* 4 (atan bulg) (- (1+ (fix add_pt)) add_pt)) 4))
)
)
(vla-update obj)
)
(defun break_lw (js js_b / i tmp_name tmp_obj ent obj vrt_pt pt lst_pt dxf_obj xd_l dxf_43 dxf_38 dxf_39 dxf_10 dxf_40 dxf_41 dxf_42 dxf_39 dxf_210 n_vtx l)
(cond
((and js js_b)
(setq
tmp_name (ssname js_b 0)
tmp_obj (vlax-ename->vla-object tmp_name)
)
(repeat (setq i (sslength js))
(setq
ent (ssname js (setq i (1- i)))
obj (vlax-ename->vla-object ent)
vrt_pt (vlax-variant-value (vla-IntersectWith obj tmp_obj 0))
)
(if (>= (vlax-safearray-get-u-bound vrt_pt 1) 0)
(progn
(setq pt (vlax-safearray->list vrt_pt))
(if pt
(if (> (length pt) 3)
(repeat (/ (length pt) 3)
(setq lst_pt (cons (list (car pt) (cadr pt) (caddr pt)) lst_pt) pt (cdddr pt))
)
(setq lst_pt (cons pt lst_pt))
)
)
)
)
(setq dxf_10 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent))))
(if (and lst_pt (listp lst_pt))
(foreach el lst_pt
(if (not (member T (mapcar '(lambda (x) (equal (list (car el) (cadr el)) x 1E-8)) dxf_10)))
(add_vtx obj (vlax-curve-getparamatpoint obj (vlax-curve-getClosestPointTo obj el)) ent)
)
)
)
(setq
dxf_obj (entget ent (list "*"))
xd_l (assoc -3 dxf_obj)
)
(if (cdr (assoc 43 dxf_obj))
(setq dxf_43 (cdr (assoc 43 dxf_obj)))
(setq dxf_43 0.0)
)
(if (cdr (assoc 38 dxf_obj))
(setq dxf_38 (cdr (assoc 38 dxf_obj)))
(setq dxf_38 0.0)
)
(if (cdr (assoc 39 dxf_obj))
(setq dxf_39 (cdr (assoc 39 dxf_obj)))
(setq dxf_39 0.0)
)
(setq
dxf_10 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) dxf_obj))
dxf_40 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 40)) dxf_obj))
dxf_41 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 41)) dxf_obj))
dxf_42 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 42)) dxf_obj))
dxf_210 (cdr (assoc 210 dxf_obj))
)
(if (not (zerop (boole 1 (cdr (assoc 70 dxf_obj)) 1)))
(setq
dxf_10 (append dxf_10 (list (car dxf_10)))
dxf_40 (append dxf_40 (list (car dxf_40)))
dxf_41 (append dxf_41 (list (car dxf_41)))
dxf_42 (append dxf_42 (list (car dxf_42)))
)
)
(setq lst_pt (reverse (mapcar '(lambda (x) (list (car (trans x 0 ent)) (cadr (trans x 0 ent)))) lst_pt)))
(repeat (length lst_pt)
(setq n_vtx -1 l nil)
(if (vl-position T (mapcar '(lambda (x) (equal x (car lst_pt) 1E-8)) dxf_10))
(entmake
(append
(list
(cons 0 "LWPOLYLINE")
(cons 100 "AcDbEntity")
(assoc 67 dxf_obj)
(assoc 410 dxf_obj)
(assoc 8 dxf_obj)
(if (assoc 62 dxf_obj) (assoc 62 dxf_obj) (cons 62 256))
(if (assoc 6 dxf_obj) (assoc 6 dxf_obj) (cons 6 "BYLAYER"))
(if (assoc 370 dxf_obj) (assoc 370 dxf_obj) (cons 370 -1))
(cons 100 "AcDbPolyline")
(cons 90 (1+ (vl-position T (mapcar '(lambda (x) (equal x (car lst_pt) 1E-8)) dxf_10))))
(cons 70 (boole 1 (cdr (assoc 70 dxf_obj)) 128))
(cons 38 dxf_38)
(cons 39 dxf_39)
)
(reverse
(repeat (1+ (vl-position T (mapcar '(lambda (x) (equal x (car lst_pt) 1E-8)) dxf_10)))
(setq l
(append
(list
(cons 42 (nth (1+ n_vtx) dxf_42))
(cons 41 (nth (1+ n_vtx) dxf_41))
(cons 40 (nth (1+ n_vtx) dxf_40))
(cons 10 (nth (setq n_vtx (1+ n_vtx)) dxf_10))
)
l
)
)
)
)
(list (assoc 210 dxf_obj))
(if xd_l (list xd_l) '())
)
)
)
(repeat n_vtx
(setq dxf_10 (cdr dxf_10) dxf_40 (cdr dxf_40) dxf_41 (cdr dxf_41) dxf_42 (cdr dxf_42))
)
(setq lst_pt (cdr lst_pt))
)
(setq n_vtx -1 l nil)
(entmake
(append
(list
(cons 0 "LWPOLYLINE")
(cons 100 "AcDbEntity")
(assoc 67 dxf_obj)
(assoc 410 dxf_obj)
(assoc 8 dxf_obj)
(if (assoc 62 dxf_obj) (assoc 62 dxf_obj) (cons 62 256))
(if (assoc 6 dxf_obj) (assoc 6 dxf_obj) (cons 6 "BYLAYER"))
(if (assoc 370 dxf_obj) (assoc 370 dxf_obj) (cons 370 -1))
(cons 100 "AcDbPolyline")
(cons 90 (length dxf_10))
(cons 70 (boole 1 (cdr (assoc 70 dxf_obj)) 128))
(cons 38 dxf_38)
(cons 39 dxf_39)
)
(reverse
(repeat (length dxf_10)
(setq l
(append
(list
(cons 42 (nth (1+ n_vtx) dxf_42))
(cons 41 (nth (1+ n_vtx) dxf_41))
(cons 40 (nth (1+ n_vtx) dxf_40))
(cons 10 (nth (setq n_vtx (1+ n_vtx)) dxf_10))
)
l
)
)
)
)
(list (assoc 210 dxf_obj))
(if xd_l (list xd_l) '())
)
)
(entdel ent)
)
)
)
)
(defun PolylineByLayer (l_pt ss_b / ss i pline ename layer len area lst sub)
(if (setq ss (ssget "_CP" l_pt (append (list '(0 . "LWPOLYLINE") '(-4 . "<NOT") '(8 . "Box*,0") '(-4 . "NOT>") (cons 410 (getvar "CTAB"))))))
(progn
(break_lw ss ss_b)
(if (setq ss (ssget "_WP" l_pt (append (list '(0 . "LWPOLYLINE") '(-4 . "<NOT") '(8 . "Box*,0") '(-4 . "NOT>") (cons 410 (getvar "CTAB"))))))
(repeat (setq i (sslength ss))
(setq
pline (ssname ss (setq i (1- i)))
ename (vlax-ename->vla-object pline)
layer (cdr (assoc 8 (entget pline)))
)
(if (vlax-property-available-p ename 'Length)
(setq len (vlax-get ename 'Length))
(setq len 0.0)
)
(if (vlax-property-available-p ename "Area")
(setq area (vlax-get ename 'Area))
(setq area 0.0)
)
(setq lst
(if (setq sub (assoc layer lst))
(subst (list layer (1+ (cadr sub)) (+ (caddr sub) len) (+ (cadddr sub) area)) sub lst)
(cons (list layer 1 len area) lst)
)
)
)
)
)
)
)
(defun WriteExcel (data / xlApp wBook cells i j)
(setq
xlApp (vlax-create-object "Excel.Application")
wBook (vlax-invoke-method (vlax-get-property xlapp 'WorkBooks) 'Add)
cells (vlax-get-property xlApp 'Cells)
i 0
)
(foreach row data
(setq i (1+ i) j 0)
(foreach val row
(setq
j (1+ j)
cell (vlax-variant-value (vlax-get-property cells 'Item i j))
)
(vlax-put-property cell 'Value2 val)
)
)
(vlax-invoke-method
(vlax-get-property
(vlax-get-property xlApp 'ActiveSheet)
'Columns
)
'AutoFit
)
(vlax-put-Property xlApp 'Visible :vlax-true)
)
(defun c:boxinfo ( / areaname ss_box ename dxf_ent lpt data)
(while (/= (setq areaname (getstring "\nArea name >")) "")
(princ "\nSelect selection boundary")
(while (null (setq ss_box (ssget "_+.:E:S" '((0 . "LWPOLYLINE")))))
(princ "\nOject isn't valide")
)
(setq ename (ssname ss_box 0))
(vla-Offset (vlax-ename->vla-object ename) -1.0)
(setq
dxf_ent (entget (entlast))
lpt (mapcar '(lambda (x) (trans x ename 0)) (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) dxf_ent)))
)
(entdel (entlast))
(setq data (append (mapcar '(lambda (x) (cons areaname x))(PolylineByLayer lpt ss_box)) data))
)
(if data (WriteExcel (cons (list "Box name" "Layer" "Item" "Length" "Area") data)))
(prin1)
)
