Jump to content

Piling As built


jason tay

Recommended Posts

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

  • Like 1
Link to comment
Share on other sites

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

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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?

Link to comment
Share on other sites

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

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...