Jump to content
jason tay

Piling As built

Recommended Posts

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.:P

Example piling as built.dwg

Share this post


Link to post
Share on other sites
Ritch7

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

Share this post


Link to post
Share on other sites
Ritch7

try attatching it again:wink:

Share this post


Link to post
Share on other sites
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 :)

Share this post


Link to post
Share on other sites
NBC

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

Share this post


Link to post
Share on other sites
Ritch7

who are you talking to?

Share this post


Link to post
Share on other sites
ASMI
who are you talking to?

 

To jason tay.

Share this post


Link to post
Share on other sites
eldon

ASMI

 

That is one very useful routine - thank you very much :D

 

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:D

Share this post


Link to post
Share on other sites
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.

Share this post


Link to post
Share on other sites
jason tay

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

Share this post


Link to post
Share on other sites
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.

Share this post


Link to post
Share on other sites
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 :)

Share this post


Link to post
Share on other sites
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 :)

Share this post


Link to post
Share on other sites
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

Share this post


Link to post
Share on other sites
jason tay

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

Share this post


Link to post
Share on other sites
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?

Share this post


Link to post
Share on other sites
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.

Share this post


Link to post
Share on other sites
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

Share this post


Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now

×