Piling As built

[jason tay]

Hi all,i have a lisp which can get the piling as built deviation

but need to click one by one.

1.Click the proposed position

2.Click the as built pile position

3.Place the deviation

(This is what i do so far)

I wonder any lisp which can get the piling as built deviation automatic ?because i alway need to click the piling point (as built)

for not less than 600 pile:(

attach here with example drawing which i have done

Hope my question not sound crazy:oops: or i expect too much which lisp can do.

Example piling as built.dwg

[Ritch7]

hi jason i would love to help but i cant open the drawing it just says error needs to close everytime :x

[Ritch7]

try attatching it again:wink:

[jason tay]

sorry here is the file again:oops:

Example piling as built-1.dwg

[Ritch7]

hey jason i dont know whats going on, i have inventor installed and i cannot open it?! it might be mine im not sure, maybe some others can open it? it just comes up as "error cannot open file drwg needs to close" very annoying lol, if no one else can view/help you with it send me it via email etc and il be glad to help you as much as i can

[NBC]

Both files opened up find on my machine. Using Map 2007 and 2008

[ASMI]

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.

Deviation_Tag.LSP

Deviation_LB.dwg

Deviation_LT.dwg

Deviation_RB.dwg

Deviation_RT.dwg

[Ritch7]

who are you talking to?

[ASMI]

who are you talking to?

 

To jason tay.

[eldon]

ASMI

 

That is one very useful routine - thank you very much

 

I am not sure the Original Poster will be too happy, because he wanted an Automatic routine, but I am very happy clicking away. :D

[jason tay]

Hi ASMI, thanks with the routine...it similar to what i have and it still need to be click one by one and this is the problem i face because my as built point always more than 600 point .I wonder we could create a proposed pile point then overlaping with as built point and the deviation result could come out.

[jason tay]

Eldon, clicking one by one is ok for few point but if that is thousand point then is a nightmare

[eldon]

Eldon, clicking one by one is ok for few point but if that is thousand point then is a nightmare

 

Say it takes you ten seconds to mark one deviation, then one thousand points would only take you two hours, which is far less time than seeking an automatic solution

 

Perhaps your data is not set up to allow an automatic solution. For example, when you have a double pile cap, how do you differentiate between the two piles? Perhaps it would be easier if you had a data list of the theoretical position, and a list of the as-built position, and get a routine to work out the deviation and plot the as-built. To make an automatic solution work, you must have the correct data set-up.

 

But best of luck in your search, but sometimes it is quicker to put in some elbow grease.

[jason tay]

can any one just let me know if to get point deviation

automatic need a special program(and point me the link) or is hard to done by lisp.Thanks for all the help

[jason tay]

Eldon, what you say is what i think all the way i do the job.

I see a lot of impossible things come to possible at this forum with help from all the great guru here..thats why i ask

[ASMI]

Automatic. For your drawing its works fine, for others I don't know.

 

1. Select any pile block

2. Select any 'as built' point

3. Pick one or more 'proposed points' for this 'pile' block and Spacebar to continue.

4. Select all 'piles' blocks and press Spacebar.

 

Enjoy...

 

(defun c:deviation(/ ABPNT ACTDOC BLPATH BSPOS CURFIL CURPT DEVAL
	   FILLST FILLST1 FILLST2 INPT INSBL INSPT OFFLST
	   OLDECHO OLDOSN PLBLK PPLIST PT1 PT2 PTLST PTSET
	   WPT WRKSET ERRCOUNT *ERROR*)
 (vl-load-com)

    (defun *error* (msg)
      (setvar "CMDECHO" oldEcho)
      (if oldOsn
 (setvar "OSMODE" oldOsn)
 ); end if
      (if actDoc
 (vla-EndUndoMark actDoc)
 ); end if
      (princ)
     ); end of *error*

 (setq oldEcho(getvar "cmdecho"))
 (setvar "CMDECHO" 0)
 (if
   (and
     (setq plBlk(entsel "\nPick 'pile' block > "))
     (= "INSERT"(cdr(assoc 0(setq filLst1(entget(car plBlk))))))
    ); end and
   (progn
     (if
(and
  (setq abPnt(entsel "\nPick 'as built' point > "))
         (= "POINT"(cdr(assoc 0(setq filLst2(entget(car abPnt))))))
 ); end and
(progn
  (setq filLst(list '(0 . "INSERT")(assoc 2 filLst1)))
  (while
    (setq curPt
	(getpoint "\nSpecify 'proposed points' or Spacebar to continue > "))
    (setq ppList(append(list curPt)ppList))
   ); end while
  (if ppList
    (progn
      (princ "\n <<< Select piles  >>> ")
      (if
	(setq wrkSet(ssget filLst))
	(progn
	  (setq wrkSet(vl-remove-if 'listp 
                               (mapcar 'cadr(ssnamex wrkSet)))
		offLst(mapcar
			'(lambda(x)
			   (mapcar '-(trans(cdr(assoc 10 filLst1))0 1)x))ppList)
		oldOsn(getvar "OSMODE")
		actDoc(vla-get-ActiveDocument
			(vlax-get-acad-object))
		); end setq
	  (vla-StartUndoMark actDoc)
	  (setvar "OSMODE" 0)
	  (foreach pl wrkSet
	    (setq insPt(trans(cdr(assoc 10(entget pl)))0 1)
		  ptLst(reverse(mapcar '(lambda(x)(mapcar '+ insPt x))offLst))
		  ); end setq
	    (foreach pt ptLst
	      (setq pt1(mapcar '- pt '(1.0 1.0 0.0))
		    pt2(mapcar '+ pt '(1.0 1.0 0.0))
		    curFil(list '(0 . "POINT")(assoc 8 filLst2))
		    errCount 0
		    ); end setq
	      (if
		(setq ptSet(ssget "_W" pt1 pt2 curFil))
		(progn
		  (if(= 1(sslength ptSet))
		    (progn
		      (setq wPt(ssname ptSet 0)
			    bsPos(trans(cdr(assoc 10(entget wPt)))0 1)
			    deVal(mapcar '- pt bsPos)
			    ); end setq
		            (cond
                              ((and
                               (<=(car pt)(car bsPos))
                               (<(cadr pt)(cadr bsPos))
                               ); end and
                              (setq insBl "Deviation_RT")
			       (if(<=(cadr pt)(cadr insPt))
				  (setq inPt(mapcar '- pt '(-0.5 3.5 0.0))) 
				  (setq inPt(mapcar '+ pt '(0.5  0.5 0.0)))
				 ); end if
                              ); end condition #1
                             ((and
                               (>=(car pt)(car bsPos))
                               (>=(cadr pt)(cadr bsPos))
                              ); end and
                             (setq insBl "Deviation_LB")
			      (if(<=(cadr pt)(cadr insPt))
				  (setq inPt(mapcar '- pt '(0.5  0.5 0.0)))
				  (setq inPt(mapcar '+ pt '(-0.5 3.5 0.0)))
				 ); end if
                              ); end condition #2
                             ((and
                              (<=(car pt)(car bsPos))
                              (>=(cadr pt)(cadr bsPos))
                             ); end and
                              (setq insBl "Deviation_RB")
			      (if(<=(cadr pt)(cadr insPt))
				  (setq inPt(mapcar '- pt '(0.5  0.5 0.0)))
				  (setq inPt(mapcar '+ pt '(-0.5 3.5 0.0)))
				 ); end if
                             ); end condition #3
                                     ((and
                              (>=(car pt)(car bsPos))
                              (<=(cadr pt)(cadr bsPos))
                             ); end and
                            (setq insBl "Deviation_LT")
			       (if(<=(cadr pt)(cadr insPt))
				  (setq inPt(mapcar '- pt '(-0.5 3.5 0.0)))
				  (setq inPt(mapcar '+ pt '(0.5  0.5 0.0)))
				 ); end if
                             ); end condition #4
                            ); end cond
		        (if(not(tblsearch "BLOCK" insBl))
                                 (progn
                                   (if
                                     (setq blPath(findfile(strcat insBl ".dwg")))
                              (command "-insert" blPath "_s" "1" inPt "0"
	                      (rtos(abs(*(car deVal)1000))2 0)
	                      (rtos(abs(*(cadr deVal)1000))2 0))
                                   (alert(strcat "\n*** File " (strcat insBl ".dwg") " not found! *** "))
                                ); end if
                               ); end progn
                                (command "-insert" insBl "_s" "1" inPt "0"
                          (rtos(abs(*(car deVal)1000)) 2 0)
                          (rtos(abs(*(cadr deVal)1000)) 2 0))
			  ); end if
		      );end progn
		      (setq errCount(1+ errCount))
		    ); end if
		  ); end progn
		); end if
	      ); end foreach
	    ); end foreach
	  ); end progn
	(princ "\n>>> Empty selection. Quite. <<< ")
	); end if
      ); end progn
    ); end if
  ); end progn
(princ "\n>>> It isn't point or empty selection. Quite. <<< ")
); end if
     ); end progn
   (princ "\n>>> It isn't block or empty selection. Quite. <<< ")
   ); end if
 (setvar "cmdecho" oldEcho)
 (if oldOsn
 (setvar "OSMODE" oldOsn)
   ); end if
 (if actDoc
 (vla-EndUndoMark actDoc)
  ); end if
 (if(/= 0 errCount)
   (alert
     (strcat "Can't draw deviation tag(s) for " (itoa  errCount) " points!"))
   ); end if
 (princ)
 ); end of c:deviation

 

This is very fresh code and there may be some bugs.

Deviation_LB.dwg

Deviation_RB.dwg

Deviation_RT.dwg

Deviation_LT.dwg

[jason tay]

ASMI , thanks to you first ..i will try on it once i done the on hand urgent job

[jason tay]

ASMI, this lisp seem great but why went i try it on the final it will pop up and "enter attributes" ask for VALUET and VALUEL (i try the first lisp you write also pop up the same things) ?

another things can the final result not in block form?

[ASMI]

Set ATTDIA = 0. I fogot about this variable. I can add it to code with also ATTREQ = 1 variable. But look first for other bugs.

[ASMI]

Code with ATTDIA and ATTREC change and restore and compare drawing (old by hand and new with this program).

 

(defun c:deviation(/ ABPNT ACTDOC BLPATH BSPOS CURFIL CURPT DEVAL
	   FILLST FILLST1 FILLST2 INPT INSBL INSPT OFFLST
	   OLDECHO OLDOSN PLBLK PPLIST PT1 PT2 PTLST PTSET
	   WPT WRKSET ERRCOUNT VARLST OLDVARS *ERROR*)
 (vl-load-com)

    (defun *error* (msg)
      (if oldVars
 (mapcar 'setvar varLst oldVars)
 ); end if
      (if actDoc
 (vla-EndUndoMark actDoc)
 ); end if
      (princ)
     ); end of *error*

 (if
   (and
     (setq plBlk(entsel "\nPick 'pile' block > "))
     (= "INSERT"(cdr(assoc 0(setq filLst1(entget(car plBlk))))))
    ); end and
   (progn
     (if
(and
  (setq abPnt(entsel "\nPick 'as built' point > "))
         (= "POINT"(cdr(assoc 0(setq filLst2(entget(car abPnt))))))
 ); end and
(progn
  (setq filLst(list '(0 . "INSERT")(assoc 2 filLst1)))
  (while
    (setq curPt
	(getpoint "\nSpecify 'proposed points' or Spacebar to continue > "))
    (setq ppList(append(list curPt)ppList))
   ); end while
  (if ppList
    (progn
      (princ "\n <<< Select piles  >>> ")
      (if
	(setq wrkSet(ssget filLst))
	(progn
	  (setq wrkSet(vl-remove-if 'listp 
                               (mapcar 'cadr(ssnamex wrkSet)))
		offLst(mapcar
			'(lambda(x)
			   (mapcar '-(trans(cdr(assoc 10 filLst1))0 1)x))ppList)
		varLst (list "CMDECHO" "OSMODE" "ATTDIA" "ATTREQ")
		oldVars(mapcar 'getvar varLst)
		actDoc(vla-get-ActiveDocument
			(vlax-get-acad-object))
		); end setq
	  (vla-StartUndoMark actDoc)
	  (mapcar 'setvar varLst '(0 0 0 1))
	  (foreach pl wrkSet
	    (setq insPt(trans(cdr(assoc 10(entget pl)))0 1)
		  ptLst(reverse(mapcar '(lambda(x)(mapcar '+ insPt x))offLst))
		  ); end setq
	    (foreach pt ptLst
	      (setq pt1(mapcar '- pt '(1.0 1.0 0.0))
		    pt2(mapcar '+ pt '(1.0 1.0 0.0))
		    curFil(list '(0 . "POINT")(assoc 8 filLst2))
		    errCount 0
		    ); end setq
	      (if
		(setq ptSet(ssget "_W" pt1 pt2 curFil))
		(progn
		  (if(= 1(sslength ptSet))
		    (progn
		      (setq wPt(ssname ptSet 0)
			    bsPos(trans(cdr(assoc 10(entget wPt)))0 1)
			    deVal(mapcar '- pt bsPos)
			    ); end setq
		            (cond
                              ((and
                               (<=(car pt)(car bsPos))
                               (<(cadr pt)(cadr bsPos))
                               ); end and
                              (setq insBl "Deviation_RT")
			       (if(<=(cadr pt)(cadr insPt))
				  (setq inPt(mapcar '- pt '(-0.5 3.5 0.0))) 
				  (setq inPt(mapcar '+ pt '(0.5  0.5 0.0)))
				 ); end if
                              ); end condition #1
                             ((and
                               (>=(car pt)(car bsPos))
                               (>=(cadr pt)(cadr bsPos))
                              ); end and
                             (setq insBl "Deviation_LB")
			      (if(<=(cadr pt)(cadr insPt))
				  (setq inPt(mapcar '- pt '(0.5  0.5 0.0)))
				  (setq inPt(mapcar '+ pt '(-0.5 3.5 0.0)))
				 ); end if
                              ); end condition #2
                             ((and
                              (<=(car pt)(car bsPos))
                              (>=(cadr pt)(cadr bsPos))
                             ); end and
                              (setq insBl "Deviation_RB")
			      (if(<=(cadr pt)(cadr insPt))
				  (setq inPt(mapcar '- pt '(0.5  0.5 0.0)))
				  (setq inPt(mapcar '+ pt '(-0.5 3.5 0.0)))
				 ); end if
                             ); end condition #3
                                     ((and
                              (>=(car pt)(car bsPos))
                              (<=(cadr pt)(cadr bsPos))
                             ); end and
                            (setq insBl "Deviation_LT")
			       (if(<=(cadr pt)(cadr insPt))
				  (setq inPt(mapcar '- pt '(-0.5 3.5 0.0)))
				  (setq inPt(mapcar '+ pt '(0.5  0.5 0.0)))
				 ); end if
                             ); end condition #4
                            ); end cond
		        (if(not(tblsearch "BLOCK" insBl))
                                 (progn
                                   (if
                                     (setq blPath(findfile(strcat insBl ".dwg")))
                              (command "-insert" blPath "_s" "1" inPt "0"
	                      (rtos(abs(*(car deVal)1000))2 0)
	                      (rtos(abs(*(cadr deVal)1000))2 0))
                                   (alert(strcat "\n*** File " (strcat insBl ".dwg") " not found! *** "))
                                ); end if
                               ); end progn
                                (command "-insert" insBl "_s" "1" inPt "0"
                          (rtos(abs(*(car deVal)1000)) 2 0)
                          (rtos(abs(*(cadr deVal)1000)) 2 0))
			  ); end if
		      );end progn
		      (setq errCount(1+ errCount))
		    ); end if
		  ); end progn
		); end if
	      ); end foreach
	    ); end foreach
	  ); end progn
	(princ "\n>>> Empty selection. Quite. <<< ")
	); end if
      ); end progn
    ); end if
  ); end progn
(princ "\n>>> It isn't point or empty selection. Quite. <<< ")
); end if
     ); end progn
   (princ "\n>>> It isn't block or empty selection. Quite. <<< ")
   ); end if
 (if oldVars
    (mapcar 'setvar varLst oldVars)
   ); end if
 (if actDoc
   (vla-EndUndoMark actDoc)
  ); end if
 (if(/= 0 errCount)
   (alert
     (strcat "Can't draw deviation tag(s) for " (itoa  errCount) " points!"))
   ); end if
 (princ)
 ); end of c:deviation

Compare.dwg