Jump to content

Recommended Posts

Posted

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 ,

 

extraction 2.jpg

extraction 1.jpg

Posted

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?

  • Like 1
Posted (edited)
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 by Romiui
Posted (edited)

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 by Jonathan Handojo
  • Like 1
Posted
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 :facepalm::cry:

  • Like 1
Posted
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 :facepalm::cry:

 

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

  • Like 1
Posted
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 :) 
 

Posted
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 :facepalm::cry:


yes , thats totally right :)

 

Posted (edited)

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 by Jonathan Handojo
  • Like 1
Posted
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

Posted (edited)

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 by hanhphuc
ocr
Posted (edited)

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 by Jonathan Handojo
  • Like 1
Posted
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.

 

Posted

@Jonathan Handojo

Dude !

U ARE Genius

please dude , send me you're paypal acount !

please ! 

Thanks , that was Awesome :)

Posted (edited)

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

thank you :) 

 

Edited by Romiui
Posted

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

 

image.png.719ccbd8176f83dc92bda55da5d835f7.png

:D

 

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...

 

  • Like 1
Posted (edited)


@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 by Romiui
Posted
On 5/10/2020 at 12:58 PM, Jonathan Handojo said:

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

 

image.png.719ccbd8176f83dc92bda55da5d835f7.png

:D

 

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  🤗

Posted

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?

  • Like 1

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...