Data Extraction coordinates to excel

[Romiui]

17 hours ago, Jonathan Handojo said:

Technically I'm only using the end points of the IFC drawings, which explain why it didn't capture some of the points whose end point is residing on the As-Builts.

 

I didn't knew you want it that way.

 

P.S. you're not the only one around here who's free of time you know. I have my own duties to carry as well!

 

(defun c:survey ( / *error* acadobj activeundo adoc all dets esclays i instpt lay1 lay2 layers ln msp pointheight rtn ss tolerance totable txthgt vtab)
    (defun *error* ( msg )
	(vla-EndUndoMark adoc)
	(if (not (wcmatch (strcase msg T) "*break*,*cancel*,*exit*"))
	    (princ (strcat "Error: " msg))
	    )
	)
    (setq acadobj (vlax-get-acad-object)
	  adoc (vla-get-ActiveDocument acadobj)
	  msp (vla-get-ModelSpace adoc)
	  activeundo nil)
    (if (= 0 (logand 8 (getvar "UNDOCTL"))) (vla-StartUndoMark adoc) (setq activeundo T))

    (setq
	
	;; ------------------------------------------ SETUPS ------------------------------------------ ;;
	
	layers '("IFC" "As-Built")	; <--- a list of two strings (texts) representing the layer of the texts
					;  ^^^ the first layer will be compared to the second.
	pointheight 400			; <--- the text height for the labels on the drawing
	tolerance 200			; <--- the tolerance (how far apart should the points be to still be considered equal)

	;; Table generated will only look based on screen size, so irrespective of zoom
	
	;; ------------------------------------------ SETUPS ------------------------------------------ ;;
	
	esclays (mapcar '(lambda (x) (cons 8 (LM:escapewildcards x))) layers)
	)
    (if
	(and
	    (setq ss (ssget (append '((0 . "LINE") (-4 . "<OR")) esclays '((-4 . "OR>")))))
	    (foreach x (setq ln (JH:selset-to-list ss))
		(if (eq (strcase (cdr (assoc 8 (entget x)))) (strcase (car layers)))
		    (setq lay1 (cons (list (vlax-curve-getStartPoint x) (vlax-curve-getEndPoint x)) lay1))
		    (setq lay2 (cons (list (vlax-curve-getStartPoint x) (vlax-curve-getEndPoint x)) lay2))
		    )
		)
	    (setq all (LM:UniqueFuzz (append (apply 'append lay1) (apply 'append lay2)) 1e-4))
	    (progn
		(foreach x all
		    (vl-some
			'(lambda (y / cl)
			     (if
				 (and
				     (equal x (setq cl (vlax-curve-getClosestPointTo y x)) tolerance)
				     (null (equal x cl 1e-4))
				     )
				 (setq rtn (cons (list x cl) rtn))
				 )
			     )
			ln
			)
		    )
		rtn
		)
	    (setq instpt (getpoint "\nSpecify insertion point for table: "))
	    )
	(progn
	    (setq i 0
		  txthgt (* 0.011 (getvar 'viewsize))
		  dets
		     (mapcar
			 '(lambda (x / vt)
			      (vla-put-Alignment
				  (setq vt (vla-AddText msp (itoa (setq i (1+ i))) (vlax-3d-point 0 0 0) pointheight))
				  acAlignmentTopLeft
				  )
			      (vla-put-TextAlignmentPoint vt (vlax-3d-point (car x)))
			      (list
				  (itoa i)
				  (rtos (cadar x) 2 3)
				  (rtos (caar x) 2 3)
				  (rtos (cadr (last x)) 2 3)
				  (rtos (car (last x)) 2 3)
				  (rtos (apply '- (mapcar 'cadr x)) 2 0)
				  (rtos (apply '- (mapcar 'car x)) 2 0)
				  (rtos (apply 'distance x) 2 0)
				  "OUT"
				  )
			      )
			 rtn
			 )
		  totable
		     (cons '("" "DESIGN" "" "AS-BUILT" "" "DIFFERENCE" "" "" "DISCR")
			   (cons '("S No." "NORTHING" "EASTING" "NORTHING" "EASTING" "DIF N" "DIF E" "DIF DIST" "") dets)
			   )
		  vtab (vla-AddTable msp (vlax-3d-point instpt) (+ 2 (length dets)) 9 (* 2 txthgt) (* 15 txthgt)) 
		  )
	    (vla-put-RegenerateTableSuppressed vtab :vlax-true)
	    (vla-UnmergeCells vtab 0 (1+ (length dets)) 0 8)
	    (foreach x
		     '(
		       (0 0 1 2)
		       (0 0 3 4)
		       (0 0 5 7)
		       (0 1 8 8)
		       )
		(apply 'vla-MergeCells (append (list vtab) x))
		)
	    (vla-put-RegenerateTableSuppressed (JH:put-list-to-table vtab totable 0 0 txthgt) :vlax-false)
	    )
	)
    (if activeundo nil (vla-EndUndoMark adoc))
    (princ)
    )

;; JH:selset-to-list --> Jonathan Handojo
;; Returns a list of entities from a selection set
;; ss - selection set

(defun JH:selset-to-list (selset / lst iter)
    (if selset
	(repeat (setq iter (sslength selset))
	    (setq lst (cons (ssname selset (setq iter (1- iter))) lst))
	    )
	)
    )

;; JH:put-list-to-table --> Jonathan Handojo
;; Attempts to put a list of texts into a table.
;; vtab - table VLA object
;; lst - a list where each item is another list of strings to be put into the table
;; row - the first (upper) row where the list will be inserted (zero-based index)
;; col - the first (left) column where the list will be inserted (zero-based index)
;; hgt - text height on table (nil to ignore)

(defun JH:put-list-to-table (vtab lst row col hgt / activesuppressed i j)
    (if (eq (vla-get-RegenerateTableSuppressed vtab) :vlax-true)
	(setq activesuppressed T)
	(vla-put-RegenerateTableSuppressed vtab :vlax-true)
	)
    (setq i 0)
    (foreach x lst
	(setq j -1)
	(foreach y x
	    (vl-catch-all-apply 'vla-SetText (list vtab (+ row i) (+ col (setq j (1+ j))) y))
	    (if hgt
		(vl-catch-all-apply 'vla-SetCellTextHeight (list vtab (+ row i) (+ row j) hgt))
		)
	    )
	(setq i (1+ i))
	)
    (if (null activesuppressed) (vla-put-RegenerateTableSuppressed vtab :vlax-false))
    vtab
    )

;;; -------------------------------- ONLINE REFERENCES -------------------------------- ;;;

;; Escape Wildcards  -  Lee Mac
;; Escapes wildcard special characters in a supplied string

(defun LM:escapewildcards ( str )
    (vl-list->string
        (apply 'append
            (mapcar
               '(lambda ( c )
                    (if (member c '(35 64 46 42 63 126 91 93 45 44))
                        (list 96 c)
                        (list c)
                    )
                )
                (vl-string->list str)
            )
        )
    )
)

;; Unique with Fuzz  -  Lee Mac
;; Returns a list with all elements considered duplicate to
;; a given tolerance removed.

(defun LM:UniqueFuzz ( l f / x r )
    (while l
        (setq x (car l)
              l (vl-remove-if (function (lambda ( y ) (equal x y f))) (cdr l))
              r (cons x r)
        )
    )
    (reverse r)
)

 

Some areas that you clouded don't even have end points. How the hell is it supposed to find those then?

i've been rude i know ,

sorry for that
u were my only help here , so thank you .
the lisp is much better now ..
some update needed but i will manage with what ever in my hand now .

Thank You ^_^