Data Extraction coordinates to excel

May 7, 2020

Hi every one !
hope you all have a good day
since this corona situation started all my Surveyors left me behind without help .
i'm stuck with 300 Sheets of drawings to extract data and submit to client !

i'll brief .

i have 2 layers :

Design / As-Built

i need to extract the coordinates from both superimposed layers with difference( In /Out )

i have picture to explain i'll post it here

i really hope i can get help here even if i have to pay for it since i already been late to deliver those data !

Thank you very much ,

May 7, 2020

Since you sound desperate for help, I'll be happy to lend a hand. Over here (at least for me), I post things here for free without any copyrights (except my subfunctions)

Post a sample dwg so I can visualise better

If I'm understanding right, you have a bunch of points in your dwg on two different layers (same number of points for both layers), and you want to extract those points and export to the image shown above?

How is the DIF DIST determined?

May 7, 2020

9 minutes ago, Jonathan Handojo said:

Since you sound desperate for help, I'll be happy to lend a hand. Over here (at least for me), I post things here for free without any copyrights (except my subfunctions)

Post a sample dwg so I can visualise better

If I'm understanding right, you have a bunch of points in your dwg on two different layers (same number of points for both layers), and you want to extract those points and export to the image shown above?

How is the DIF DIST determined?

Thanks For The reply !

these are sample ;

the real deal is .. i need to see the boundary difference between as-built and the design each 0.5 meter and get points .

i have to generate these numbers .

i'll attache 1 drawing for the job and the sample of work done simller to it

Thanks !

SURVEY REPORT ( Sample ).pdf TB-1013 8th FLOOR PLAN AB.dwg

Edited May 7, 2020 by Romiui

May 7, 2020

For one reason or another I'm unable to see any points or texts, but I'm assuming you want to find the discrepancies of each of the points between the as-builts and for-construnction drawings whose points are a maximum of 0.5m (maybe max of 1) apart from one another yea?

Again, how do you calculate the DIF DIST? is that just the distance apart between the two points?

And what about the last column?

Nice building there!

Edited May 7, 2020 by Jonathan Handojo

May 7, 2020

4 minutes ago, Jonathan Handojo said:

For one reason or another I'm unable to see any points or texts, but I'm assuming you want to find the discrepancies of each of the points between the as-builts and for-construnction drawings whose points are a maximum of 0.5m (maybe max of 1) apart from one another yea?

Again, how do you calculate the DIF DIST? is that just the distance apart between the two points?

Nice building there!

distance between two points or calc hypotenuse using diff n & diff e as the sides. As its a building I would assume coords are in mm otherwise

May 7, 2020

Just now, dlanorh said:

distance between two points or calc hypotenuse using diff n & diff e as the sides. As its a building I would assume coords are in mm otherwise

Haha, apologies for my stupidity... I should've known better

May 7, 2020

16 minutes ago, Jonathan Handojo said:

For one reason or another I'm unable to see any points or texts, but I'm assuming you want to find the discrepancies of each of the points between the as-builts and for-construnction drawings whose points are a maximum of 0.5m (maybe max of 1) apart from one another yea?

Again, how do you calculate the DIF DIST? is that just the distance apart between the two points?

Nice building there!

@Jonathan

i'll brief :

red line is as-built
green is design (IFC)

we have superimposed those drawings floor by floor , and i need to make list showing the followings :

1- every 0.5m (maybe max of 1) coordinates for both as-built and design showing the DIF DIST ( the difference of distance ).
2- these points and number we have to add , it will not come with the drawings , every 0.5m (maybe max of 1) will make point with coordinate .
3- will generate those points to excel as same as the attached sample .

can you help me out making this possible !?

Thanks

May 7, 2020

14 minutes ago, dlanorh said:

distance between two points or calc hypotenuse using diff n & diff e as the sides. As its a building I would assume coords are in mm otherwise

yes , thats totally right

May 7, 2020

Definitely possible. Give me some time, I'll have a solution ready for you (or maybe someone will jump in to help as well)

Edited May 7, 2020 by Jonathan Handojo

May 7, 2020

1 minute ago, Jonathan Handojo said:

Definitely possible. Give me some time, I'll have a solution ready for you (or maybe someone will jump in to help as well)

sure

please send me you're whatsapp if possible , i have no idea if i'm breaking rules here but i indeed need help ! .. thanks

May 7, 2020

my $0.05 simple work around without LISP

1.convert PDF to EXCEL , note: PDF 'sheet' should be OCR vector image not scanned else try app convert to text file, copy to EXCEL sheet

2.populate the column xy data concatenate

3.concatenate command text & xy & textstring (depend on user using TEXT or attributes data etc..)

4.paste the command in ACAD command line

there's an old thread using field delta property but not working in Bricscad

Edited May 7, 2020 by hanhphuc
ocr

May 8, 2020

Something like this what you're after? Or am I still missing something?

(defun c:survey ( / *error* acadobj activeundo adoc dets esclays i instpt lay1 lay2 layers 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 (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 lay1 (LM:UniqueFuzz (apply 'append lay1) tolerance) lay2 (LM:UniqueFuzz (apply 'append lay2) tolerance))
	    (progn
		(foreach x lay1
		    (vl-some
			'(lambda (y)
			     (if (equal y x tolerance) (setq rtn (cons (list x y) rtn)))
			     )
			lay2
			)
		    )
		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 credits go to Lee Mac for his subfunctions.

Edited May 8, 2020 by Jonathan Handojo

May 10, 2020

On 5/8/2020 at 5:45 PM, Jonathan Handojo said:

Something like this what you're after? Or am I still missing something?


(defun c:survey ( / *error* acadobj activeundo adoc dets esclays i instpt lay1 lay2 layers 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 (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 lay1 (LM:UniqueFuzz (apply 'append lay1) tolerance) lay2 (LM:UniqueFuzz (apply 'append lay2) tolerance))
	    (progn
		(foreach x lay1
		    (vl-some
			'(lambda (y)
			     (if (equal y x tolerance) (setq rtn (cons (list x y) rtn)))
			     )
			lay2
			)
		    )
		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 credits go to Lee Mac for his subfunctions.

May 10, 2020

@Jonathan Handojo

Dude !

U ARE Genius!

please dude , send me you're paypal acount !

please !

Thanks , that was Awesome

May 10, 2020

only one thing to be updated please !
can you reduce the gap between as-built and ifc to ± 25 mm ?

thank you

Edited May 10, 2020 by Romiui

May 10, 2020

Thanks Romiui. I stick by to the title here...

You can reduce the gap in the LISP file itself. Simply change the tolerance which was 200 to 25.

I didn't know what the "OUT" and "IN" was, so I simply put "OUT" for all of them...

May 11, 2020

@Jonathan Handojo

Thanks For all the help you have provided for me

i know i'll ask again but i'm certain you can help me again ^_^

**i have attached DWG showing the readings horizontally ,vertically & curve

i have noticed one small issue into the lisp ,

1- the lisp is reading horizontally and vertically fine with no issues and no errors , but the Problem started with the curve somehow !
it start reading wrong gaps between as-built and IFC

2- if you can notice into the DWG ; the lisp is skipping some points where it should be added into location that more than 25+ mm ,

i have no idea if it working randomly or it can be forced to add point where ever the tolerance is more than 25+mm ( clouds added blue )
3- can u please send me same lisp but with update ? its to switch the reference to be from the as-built i guess it might give better readings ?!

please excuse my lack of experience to update it my self , u really big help for me

i hope i could someday find a way to pay you back this

sorry for the time gap between us , i live in MEA

waiting you're assistance .

Thank You in Advance !

TB-1013 8th FLOOR PLAN AB_Sample to edit lisp.dwg

Edited May 11, 2020 by Romiui

May 12, 2020

On 5/10/2020 at 12:58 PM, Jonathan Handojo said:

Thanks Romiui. I stick by to the title here...

You can reduce the gap in the LISP file itself. Simply change the tolerance which was 200 to 25.

I didn't know what the "OUT" and "IN" was, so I simply put "OUT" for all of them...

Hope i can get help soon

May 12, 2020

@Jonathan Handojo

can you help please !?

May 12, 2020

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?

Data Extraction coordinates to excel

Recommended Posts

Romiui

Link to comment

Share on other sites

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

Jonathan Handojo

Jonathan Handojo

dlanorh

Posted Images

Jonathan Handojo

Link to comment

Share on other sites

Romiui

Link to comment

Share on other sites

Jonathan Handojo

Link to comment

Share on other sites

dlanorh

Link to comment

Share on other sites

Jonathan Handojo

Link to comment

Share on other sites

Romiui

Link to comment

Share on other sites

Romiui

Link to comment

Share on other sites

Jonathan Handojo

Link to comment

Share on other sites

Romiui

Link to comment

Share on other sites

hanhphuc

Link to comment

Share on other sites

Jonathan Handojo

Link to comment

Share on other sites

Romiui

Link to comment

Share on other sites

Romiui

@Jonathan HandojoDude !U ARE Genius! please dude , send me you're paypal acount ! please ! Thanks , that was Awesome

Link to comment

Share on other sites

Romiui

Link to comment

Share on other sites

Jonathan Handojo

Link to comment

Share on other sites

Romiui

Link to comment

Share on other sites

Romiui

Link to comment

Share on other sites

Romiui

@Jonathan Handojo can you help please !?

Link to comment

Share on other sites

Jonathan Handojo

Link to comment

Share on other sites

Join the conversation

Tutorials

Forums

Activity

@Jonathan Handojo

Dude !

U ARE Genius!

please dude , send me you're paypal acount !

please !

Thanks , that was Awesome

@Jonathan Handojo

can you help please !?