divide polyline with points and project the distance greater than 2cm to list with coordinates

[Romiui]

hi guys !
thanks for the awesome forum and for the help .

i have small case which i asked before for it but since its urgent i need to request again 

i'll brief :


i have 2 lines Green, Red ( design and as-built )

the idea is to create points where is the gap is greater than 2 cm and add them to list with coordinates and ,

i have about 300 sheets to be submitted as report to owner within next 5 days and i'm really stuck since all my surveyors left me behind without help !


i'll attache sample again hoping to get it soon
* the dwg is the actual data i have to work with 
* the PDF is old output i have earlier from my surveyors .

 
The below code is having issues :

1-  it reads mm instead of meter 
2- it add random points "numbers" and i cant force it to add point where it needed to be ( meaning it missing to many points ) 
3- it reads wrong output on curves ! ( major issue )

i have changed the 

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)

to meter but still the output is zero's since it need to give output in meter not mm .
 

(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)
)

if any one can update this for me please !

Thanks in advance ! ..





 

TB-1010 4th FLOOR PLAN AB.dwg SURVEY REPORT ( Sample ).pdf

Edited May 12, 2020 by Romiui

[hanhphuc]

On 5/12/2020 at 2:07 PM, Romiui said:

hi guys !
thanks for the awesome forum and for the help .

i have small case which i asked before for it but since its urgent i need to request again 

The below code is having issues :

1-  it reads mm instead of meter 
2- it add random points "numbers" and i cant force it to add point where it needed to be ( meaning it missing to many points ) 
3- it reads wrong output on curves ! ( major issue )

 

 

my $0.05 suggestion for curve output if your condition of "IFC" curve = ARC with consistance radii. Then it's not difficult (if you know some LISP experience)  
i.e. This is not comparing "as-built" with your "IFC" vertices, but compare with ARC radius

 

In order to minimize brute force, JOIN "as-built" lines as polyline within arc coverages
initially you may have to re-create ARC as reference

 

method 1. get coordinates for each "as-built" vertex to arc center minus (-) the radii you can get in-out by residual distance.
                   i.e: you can calculate design coordinates (polar angle ;|asbuilt->center|; distance ;|+/-residual|; )

 

merthod 2. JOIN  "IFC" "as-built" as 2 different LWpolylines, then both using vlax-curve-getclosestpointto to create acline
                   populate aclines delta & length properties equal to (DIF E, DIF E , DIF DIST)

 

Note: if smaller or bigger arc has different radii, ie 2 selections for 2 arces 

another suggestion data out-put as csv then you can sort/edit/renumber in EXCEL, if you don't know programming just paste as OLE table

 

p/s: avoid topic with "HELP" "URGENT" "i WANT" "i NEED" , because your task is your boss' business or hire more draftmen 
you may get poor respond by poor volunteers here 

 

 

 

 

[BIGAL]

This has answers posted elsewhere.

[Jonathan Handojo]

On 5/13/2020 at 6:53 PM, hanhphuc said:

you may get poor respond by poor volunteers here 

 

Thanks for pointing out an excellent candidate...