Piling As built

February 20, 2008

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

February 20, 2008

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

February 20, 2008

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

February 20, 2008

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.

December 7, 2015

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

December 10, 2015

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

December 10, 2015

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

December 10, 2015

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

December 10, 2015

thanks ymg

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

December 10, 2015

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

trial auto compare rev1.dwg

December 10, 2015

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

December 10, 2015

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

December 10, 2015

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

December 10, 2015

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

December 10, 2015

I will give it a go in the morning

Again thank you so much for your help

December 11, 2015

thiof,

Here the attached version should work in any UCS.

compare.LSP

December 11, 2015

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

December 11, 2015

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

December 11, 2015

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

December 12, 2015

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

Sign In

Piling As built

Recommended Posts

jason tay

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

jason tay

jason tay

Posted Images

ASMI

jason tay

ASMI

thiof2000

ymg3

thiof2000

ymg3

thiof2000

thiof2000

thiof2000

ymg3

thiof2000

ymg3

thiof2000

ymg3

thiof2000

thiof2000

ymg3

ymg3

Join the conversation

jason tay

jason tay

Tutorials

Forums

Activity