Piling As built

[jason tay]

Thanks a lot ASMI,It work as you said.I will try on other drawing.(really learn a lot from you and this forum)

[ASMI]

Ok, try it on other drawings. If it need I can make user adjustible zone for finding 'as built' points.

[jason tay]

ASMI, is that mean people who do drawing in milimeter can used directly no neet to scale the drawing?

[ASMI]

Not. Millimenters, inches and so on can be as other option and I also can add it. In my country building drawings in millimeters too.

[thiof2000]

hi all,

 

 

great lisp for as built.

 

 

I was wondering if the lisp could be simplified for other purpose for example just having a deviation worked out from "design/proposed" POINTS in a specific layer against another series of points in another layer.

 

 

Basically, there would be no picking except selecting the as-built layer and another layer to compare it too.

 

 

I know ASMI has left so I am not sure anyone could help

[ymg3]

thiof,

 

Try this, I modified so there is no need to select one by one.

 

Also the blocks and style are created on loading the lisp.

So no need to keep or download any separate file.

Notes that the block keep the values in attributes,

not in text entity as it was before.

 

You select an entity on theoretical layer, and another one on

the As-Built layer. The only requirement is that dxfcode 10 of

the entity must be its position. It can be a block, a point or

a circle etc.

 

You then specify the Search Aperture which is a distance on either side

of your theoretical point where we search for an As-Built point.

 

The two next input prompts are as before, tag scale and tag offset distance.

 

From there it proceeds automatically.

 

I did not test extensively so please verify and let me know.

 

ymg

 

;; compare.lsp      by ymg                   November 2015                    ;
;;                                                                            ;
;; Derived from deviation.lsp by ASMI                                         ;
;;                                                                            ;
;; User select an entity on a layer deemed the theoretical position           ;
;; he also selects an entity on another layer considered as-built position    ;
;;                                                                            ;
;; Programs then compare Theoretical vs As-Built and annotate each position   ;
;;                                                                            ;
;; The necessary style and blocks are created upon loading this lisp          ;
;;                                                                            ;

(defun c:cmp () (c:compare))
(defun c:compare (** *acdoc* a abl apd apl app  deval enab entab enth entth errcount
                   fltab fltth inpt insbl oldcol oldoff oldsapr oldscal pt pta pth spol
                   thl varl xb xp yb yp ss2list *error*)
  
  (vl-load-com)   
  
  (or *acdoc*  (setq *acdoc*  (vla-get-ActiveDocument (vlax-get-acad-object))))
  
  (defun *error* (msg)
     (mapcar 'eval varl)
     (if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")))
        (princ (strcat "\nError: " msg))
     )
     (vla-endundomark *acdoc*)
     (princ)
  )

  ;;                                                                      ;
  ;;  Convert selection set to list of ename or vla objects               ;
  ;;     ss - SSGET selection set                                         ;
  ;;   mode - T for vla objects, nil for ename                            ;
  ;;  Alan J. Thompson, 04.20.09                                          ;
  ;;                                                                      ;

  (defun ss2list (ss mode / l)
     (and ss
          (setq l (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
          mode
          (setq l (mapcar 'vlax-ename->vla-object l))
     )
     l
  )

  (setq enth (car (entsel "\nPick an Entity on Theoretical Layer: "))
        enab (car (entsel "\nPick an Entity on As-Built Layer: "))
       entth (entget enth)
       entab (entget enab)
       fltth (list (assoc 0 entth) (assoc 8 entth))
       fltab (list (assoc 0 entab) (assoc 8 entab))
        thl  (ss2list (ssget "_A" fltth) nil)
        abl  (ss2list (ssget "_A" fltab) nil)
   errcount  0
  )
  
  (or dev:sapr (setq dev:sapr 0.5))
  (or dev:scal (setq dev:scal 0.5))
  (or dev:off  (setq dev:off  2.0))
  
  (setq oldscal dev:scal  oldoff  dev:off oldsapr dev:sapr)
  
  (setq dev:sapr (getreal (strcat "\nSpecify Search Aperture <" (rtos dev:sapr) ">: ")))
  (or dev:sapr (setq dev:sapr oldsapr))

  (setq spol (list (list (- dev:sapr) (- dev:sapr)) (list dev:sapr (- dev:sapr)) (list dev:sapr dev:sapr) (list (- dev:sapr) dev:sapr)))
  
  (setq dev:scal (getreal (strcat "\nSpecify tags scale <" (rtos dev:scal) ">: ")))
  (or dev:scal (setq dev:scal oldscal))
  
  (setq dev:off (getdist (strcat "\nSpecify point-tag offset distance <" (rtos dev:off)  ">: ")))
  (or dev:off (setq dev:off oldoff))

  (vla-startundomark *acdoc*)

  (setq varl '("CMDECHO" "OSMODE" "ATTDIA" "ATTREQ" "PDSIZE")
        varl   (mapcar (function (lambda (a) (list 'setvar a (getvar a)))) varl)
  )
  
  (setvar 'OSMODE 0)
  (setvar 'ATTREQ 1)
  (setvar 'ATTDIA 0)
  (setvar 'CMDECHO 0)
  (setvar 'PDSIZE 0.2)
  
  (foreach plblk thl
     (setq pth (cdr (assoc 10 (entget plblk)))
           apl (ss2list (ssget "_CP" (mapcar '(lambda (a) (mapcar '+ pth a)) spol) fltab) nil)
     )      
     (if apl
        (setq app (mapcar '(lambda (a) (cdr (assoc 10 (entget a)))) apl)
              apd (mapcar '(lambda (a) (distance a pth)) app)
              pta (nth (vl-position (apply 'min apd) apd) app)
            deval (mapcar '- pta pth)
               xp (car pta) yp (cadr pta)
               xb (car pth) yb (cadr pth)
             inpt (list (+ xb dev:off) yb)
            insbl (cond
                     ((and (<= xp xb) (<  (cadr pt) yb)) "Deviation_RT")
                     ((and (>= xp xb) (>  (cadr pt) yb)) "Deviation_LB")
                     ((and (<  xp xb) (>= (cadr pt) yb)) "Deviation_RB")
                     ((and (>  xp xb) (<= (cadr pt) yb)) "Deviation_LT")
                  )
               ** (command "-INSERT" insbl "_S" dev:scal inpt "0" (rtos (abs (* (car  deval) 1000)) 2 0) (rtos (abs (* (cadr  deval) 1000)) 2 0))
        )
        (progn
           (setq errcount (1+ errcount)
                 oldcol   (getvar "CECOLOR")
           )
           (setvar "CECOLOR" "1")
           (command "_.circle" pth dev:off)
           (setvar "CECOLOR" oldcol)
        )
     )
  )                  
  (if (/= 0 errcount)
     (alert (strcat "Could Not Draw Deviation Tag(s) For " (itoa errcount) " Point(s)!"
                    "\n\n                     Look For Red Circles."
            )
     )
  )  
  (*error* nil)
)
  
;; This section Entmake's the "ROMAN" style and the 4 required blocks on loading the routine.           
(entmakex '((0 . "STYLE") (100 . "AcDbSymbolTableRecord") (100 . "AcDbTextStyleTableRecord") (2 . "ROMANS") (3 . "txt.shx") (70 . 0) (40 . 0.0) (41 . 1.0) (50 . 0.0) (71 . 0))) 
  
(entmakex '((0 . "BLOCK") (67 . 0) (8 . "0") (2 . "Deviation_LB") (10 0 0 0) (70 . 2)))
(entmakex '((0 . "LINE") (8 . "Deviation") (10 -0.10 1.35 0) (11 1.35 1.35 0)))
(entmakex '((0 . "SOLID")  (67 . 0) (8 . "Deviation")  (10 0.57 1.22 0) (11 0.57 1.47 0) (12 -0.10 1.35 0) (13 -0.10 1.35 0) (39 . 0)))
(entmakex '((0 . "SOLID") (67 . 0) (8 . "Deviation") (10 1.47 0.57 0) (11 1.22 0.57 0) (12 1.35 -0.10 0) (13 1.35 -0.10 0) (39 . 0)))
(entmakex '((0 . "LINE") (8 . "Deviation") (10 1.35 -0.10 0) (11 1.35 1.35 0)))
(entmakex '((0 . "ATTDEF") (8 . "Value") (10 -1.50 1.35 0) (1 . "00") (2 . "Dx") (3 . "Delta x") (40 . 1.5) (50 . 0) (41 . 0.7) (51 . 0) (7 . "ROMANS") (70 . 0) (71 . 0) (72 . 1) (11 -1.35 1.35 0) (74 . 2)))
(entmakex '((0 . "ATTDEF") (8 . "Value") (10 1.35 -1.50 0) (1 . "00") (2 . "Dy") (3 . "Delta y") (40 . 1.5) (50 . 0) (41 . 0.7) (51 . 0) (7 . "ROMANS") (70 . 0) (71 . 0) (72 . 1) (11 1.35 -1.35 0) (74 . 2)))
(entmakex '((0 . "ENDBLK")))

(entmakex '((0 . "BLOCK") (100 . "AcDbEntity") (67 . 0) (8 . "0") (100 . "AcDbBlockReference") (2 . "Deviation_LT") (10 0 0 0) (70 . 2)))
(entmakex '((0 . "LINE") (8 . "Deviation") (10 -0.10 -1.35 0) (11 1.35 -1.35 0)))
(entmakex '((0 . "SOLID") (100 . "AcDbEntity") (67 . 0) (8 . "Deviation") (100 . "AcDbTrace") (10 0.57 -1.22 0) (11 0.57 -1.47 0) (12 -0.10 -1.35 0) (13 -0.10 -1.35 0) (39 . 0)))
(entmakex '((0 . "SOLID") (100 . "AcDbEntity") (67 . 0) (8 . "Deviation") (100 . "AcDbTrace") (10 1.47 -0.57 0) (11 1.22 -0.57 0) (12 1.35 0.10 0) (13 1.35 0.10 0) (39 . 0)))
(entmakex '((0 . "LINE") (8 . "Deviation") (10 1.35 0.10 0) (11 1.35 -1.35 0)))
(entmakex '((0 . "ATTDEF") (8 . "Value") (10 -1.50 1.35 0) (1 . "00") (2 . "Dx") (3 . "Delta x") (40 . 1.5) (50 . 0) (41 . 0.7) (51 . 0) (7 . "ROMANS") (70 . 0) (71 . 0) (72 . 1) (11 -1.35 -1.35 0) (74 . 2)))
(entmakex '((0 . "ATTDEF") (8 . "Value") (10 1.35 -1.50 0) (1 . "00") (2 . "Dy") (3 . "Delta y") (40 . 1.5) (50 . 0) (41 . 0.7) (51 . 0) (7 . "ROMANS") (70 . 0) (71 . 0) (72 . 1) (11  1.35  1.35 0) (74 . 2)))
(entmakex '((0 . "ENDBLK") (100 . "AcDbBlockEnd") (8 . "0")))

(entmakex '((0 . "BLOCK") (100 . "AcDbEntity") (67 . 0) (8 . "0") (100 . "AcDbBlockReference") (2 . "Deviation_RB") (10 0 0 0) (70 . 2)))
(entmakex '((0 . "LINE") (8 . "Deviation") (10 0.10 1.35 0) (11 -1.35 1.35 0)))
(entmakex '((0 . "SOLID") (100 . "AcDbEntity") (67 . 0) (8 . "Deviation") (100 . "AcDbTrace") (10 -0.57 1.22 0) (11 -0.57 1.47 0) (12 0.10 1.35 0) (13 0.10 1.35 0) (39 . 0)))
(entmakex '((0 . "SOLID") (100 . "AcDbEntity") (67 . 0) (8 . "Deviation") (100 . "AcDbTrace") (10 -1.47 0.57 0) (11 -1.22 0.57 0) (12 -1.35 -0.10 0) (13 -1.35 -0.10 0) (39 . 0)))
(entmakex '((0 . "LINE") (8 . "Deviation") (10 -1.35 -0.10 0) (11 -1.35 1.35 0)))
(entmakex '((0 . "ATTDEF") (8 . "Value") (10 -1.50 1.35 0) (1 . "00") (2 . "Dx") (3 . "Delta x") (40 . 1.5) (50 . 0) (41 . 0.7) (51 . 0) (7 . "ROMANS") (70 . 0) (71 . 0) (72 . 1) (11  1.35  1.35 0) (74 . 2)))
(entmakex '((0 . "ATTDEF") (8 . "Value") (10 1.35 -1.50 0) (1 . "00") (2 . "Dy") (3 . "Delta y") (40 . 1.5) (50 . 0) (41 . 0.7) (51 . 0) (7 . "ROMANS") (70 . 0) (71 . 0) (72 . 1) (11 -1.35 -1.35 0) (74 . 2)))
(entmakex '((0 . "ENDBLK") (100 . "AcDbBlockEnd") (8 . "0")))

(entmakex '((0 . "BLOCK") (100 . "AcDbEntity") (67 . 0) (8 . "0") (100 . "AcDbBlockReference") (2 . "Deviation_RT") (10 0 0 0) (70 . 2)))
(entmakex '((0 . "LINE") (8 . "Deviation") (10 0.10 -1.35 0) (11 -1.35 -1.35 0)))
(entmakex '((0 . "SOLID") (100 . "AcDbEntity") (67 . 0) (8 . "Deviation") (100 . "AcDbTrace") (10 -0.57 -1.22 0) (11 -0.57 -1.47 0) (12 0.10 -1.35 0) (13 0.10 -1.35 0) (39 . 0)))
(entmakex '((0 . "SOLID") (100 . "AcDbEntity") (67 . 0) (8 . "Deviation") (100 . "AcDbTrace") (10 -1.47 -0.57 0) (11 -1.22 -0.57 0) (12 -1.35 0.10 0) (13 -1.35 0.10 0) (39 . 0)))
(entmakex '((0 . "LINE") (8 . "Deviation") (10 -1.35 0.10 0) (11 -1.35 -1.35 0)))
(entmakex '((0 . "ATTDEF") (8 . "Value") (10 -1.50 1.35 0) (1 . "00") (2 . "Dx") (3 . "Delta x") (40 . 1.5) (50 . 0) (41 . 0.7) (51 . 0) (7 . "ROMANS") (70 . 0) (71 . 0) (72 . 1) (11  1.35 -1.35 0) (74 . 2)))
(entmakex '((0 . "ATTDEF") (8 . "Value") (10 1.35 -1.50 0) (1 . "00") (2 . "Dy") (3 . "Delta y") (40 . 1.5) (50 . 0) (41 . 0.7) (51 . 0) (7 . "ROMANS") (70 . 0) (71 . 0) (72 . 1) (11 -1.35  1.35 0) (74 . 2)))
(entmakex '((0 . "ENDBLK") (100 . "AcDbBlockEnd") (8 . "0")))


(princ "Compare.lsp Loaded!...Type compare or cmp to run")
(princ)

compare.LSP

Edited December 10, 2015 by ymg3
Corrected bug in var declaration

[thiof2000]

thanks fot your help ymg

 

 

I tried it on this simple dwg

 

 

but I get ; error: too few arguments

 

 

also, does the lisp uses World UCS or any current named UCS?

trial auto compare.dwg

Edited December 10, 2015 by thiof2000

[ymg3]

thiof,

 

I put it together quite fast, so right now it is World UCS.

 

Would be simple to transform to any UCS

 

Forgot the slash when localizing the var:

 

So change 2nd line to:

 

(defun c:compare ( / ** *acdoc* a abl apd apl app  deval enab entab enth entth errcount
                    fltab fltth inpt insbl oldcol oldoff oldsapr oldscal pt pta pth spol
                    thl varl xb xp yb yp *error* ss2list)

 

ymg

compare.LSP

Edited December 10, 2015 by ymg3

[thiof2000]

thanks ymg

 

 

ideally any ucs would be better for most of crazy shape project I work on

[thiof2000]

I get can through all the picking steps and prompt but it only draws a red circle

trial auto compare rev1.dwg

[thiof2000]

ok

I played with search aperture and reduced it lower than the biggest distance deviation of my asbuilt points and I somehow have all the arrows drawn up with the correct values.

 

 

but the arrows are not always correct. normally I do as-built data minus theoretical so it shows arrows pointing away from its design

 

 

also is it possible to convert the block to text only?

 

 

I usually run another script to change the colors depending on the values but it works with TEXT and when I explode the blocks I only have DX and DY and no values.

 

 

ymg this is so close to my dream Lisp

[ymg3]

thiof,

 

Because tour drawing is in millimeter as opposed to meters.

 

Are u an architect ?, In surveying we draw in meters.

 

So now your tag scale need to be 0.00001,

offset need to be around 0.025

 

Your drawing must be zoomed to the extent.

 

Will add all these eventually.

 

ymg

[thiof2000]

surveying but some of our clients request in mm.

 

 

but yes I noticed that when I zoomed out it did all

 

 

for boundaries coloring I use this

levbnd.lsp

[ymg3]

thiof,

 

You can use command "EATTEDIT" to change the color of an attribute.

 

And here I attached a correction for a bug in the arrow direction.

compare.LSP

[thiof2000]

I will give it a go in the morning

 

Again thank you so much for your help

[ymg3]

thiof,

 

Here the attached version should work in any UCS.

compare.LSP

[thiof2000]

ymg

 

you made my dreams come true

 

 

lisp works brilliantly.

 

 

I can BURST the blocks and use my other lisp too for range coloring.

 

 

I tried to change the layer "Dimension" to CLAYER and color to BYLAYER for the block insertion but no joy.

 

 

I also tried to modify the deviation dwg so it inserts the block at the origin of the arrows but it seems to make no difference so I guess it's in the entmakex I need to look into.

 

 

again what a lisp you did for me.

Deviation_LB.dwg

[thiof2000]

I just realised you have done a standalone lisp no need for support files so I really need to look at the entmakex to see where to change color, CLAYER and insertion point.

 

 

cheers YMG

[ymg3]

thiof,

 

Here I've cleaned up the code and added up a few "Bells and Whistles",

however you need Express Tools installed for the progress bar to be

operationnal and the program to run.

 

The Red Circles have been replaced by Red Squares of the same size

as the Search Aperture.

 

Blocks have prefix name "Compare", the layers are now "Compare_Tags"

and "Compare_Values"

 

A little report is given in the Alert Box at end of processing. Notes in the example

below the negative number on paired entities. Probably means that some

of the points are duplicated.

 

So Enjoy!

 

ymg

compare V1.0.LSP

[ymg3]

thiof,

 

Concerning LAYERS, the block are inserted on the current layer.

 

However, the block definition is on layer 0, the arrows are on layer "Compare_Tags"

and the attdef are on layer "Compare_Values".

 

So, If you "BURST" the blocks you will end up with "TEXT" on layer "Compare_Values"

and all the arrows will be on layer "Compare_Tags".

 

To clarify further, since the block definition is on layer "0", changing the color of the

layers "Compare_Tags" and "Compare_VALUES", will assign the chosen colors to

the blocks, no matter the layer it is inserted on.

 

ymg