Piling As built

[thiof2000]

hi ymg,

 

 

they always come in red the arrows and values.

 

 

where do I need to modify to have them CECOLOR bylayer?

[ymg3]

thiof,

 

What you want to do is to change color of individual attribute

based on its value. Changing the color of the layer won't help you.

 

Try this bit of code by hmsilva that I modified a little so it changes

color only when value is greater than a given aximum Deviation.

 

Notes that the blocks are not exploded or bursted, we change

independantly the color of each attribute.

 

;; Original Code by hmsilva                                                   ;
;; http://forums.autodesk.com/t5/autocad-2013-2014-2015-2016/                 ;
;;                     lisp-to-change-attribute-text-color/td-p/5570681       ;
;;                                                                            ;
;; Modified by ymg to change color only when the attribute value exceed       ;
;; a Maximum Value entered by user.                                           ;
;;                                                                            ;

(defun c:test (/ blk col i ss)

 (setq tol (getreal "\nMaximum Allowable Deviation...?"))  
  
 (if (and (princ "\nSelect blocks to change attributes color: ")
          (setq ss (ssget "_A" '((0 . "INSERT") (2 . "Compare_*") (66 . 1))))
          (setq col (acad_colordlg 1))
     )
   (repeat (setq i (sslength ss))
     (setq blk (vlax-ename->vla-object (ssname ss (setq i (1- i)))))
     (foreach att (vlax-safearray->list
                    (vlax-variant-value (vla-getattributes blk))
                  )
       (if (and (vlax-write-enabled-p att)
                (> (atoi (vla-get-textstring att)) tol)
           )     
         (vla-put-color att col)
       )
     )
   )
 )
 (princ)
)

 

Actually we could integrate this in the compare routine

and do the coloring as we compare.

 

ymg

Edited December 15, 2015 by ymg3

[thiof2000]

that would be awesome to integrate it

[saw]

It's not so difficult task. Add path to four "block" files to Tools>Options>Tab 'Files', 'Support files search path'.

 

***** EDIT ******

 

Please redounload files. That was some errors.

 

 

 

 

Thank you Very much Sir.

[saw]

Hi there, i can use this LSP well with civil3d 2012. But can not use with civil3d 2017. keep asking attributes to add value. may be coding missing some line. i don't know. please help. thanks million

[saw]

Can i Have your LISP file which can get the piling as built deviation? Thanks

[GNolder]

On 12/11/2015 at 3:22 PM, ymg3 said:

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 14.08 kB · 68 downloads

 

YMG,

This is a very usefule routine.  Can it be modified to use my block? I do survey as-built drawings for anchor bolts.  About half of the drawings I do are not rotated true north (for presentation of final asbuilt).  I also show 2 decimal places in decimal feet. Drawing file attached.  Check paper space for notes. "tolerance" block is already inserted in my drawing. Please let me know if you can help.

 

Thanks!

test compare lisp.dwg tolerance.dwg

[mysurveyors]

On 12/10/2015 at 7:24 AM, ymg3 said:

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)

 

Hi, 

is this lisp can modify to works from block to civil 3d cogo points.

compare.LSP 9.85 kB · 52 downloads