Piling As built

February 13, 2008

ASMI, i have try on the drawing i attach it work good but i face problem when the pile group is not 2 pile group.example 3 pile, 4 pile or 5 pile group etc. is that i miss out any things?or this rountine can work for 2 pile group only?

February 13, 2008

ASMI, i have try on the drawing i attach it work good but i face problem when the pile group is not 2 pile group.example 3 pile, 4 pile or 5 pile group etc. is that i miss out any things?or this rountine can work for 2 pile group only?

Not it sould works with any number of piles. Can you attach some example drawing I want to see it.

February 13, 2008

ASMI,here i attach the drawing.

another things is that the deviation must in block?

because i need to highlight the interger which is more than 75 use other lisp routine, i not sure it can work or not.

Example piling as built-2.dwg

February 13, 2008

Oh, ASMI i forgot to put the as built point. can you just create random.. sorry Sir

February 13, 2008

ASMI,here i re-attach the drawing .

at the same time i try the routine which highlight interger cannot run for block,hope the result will be not in block(Tag) form:oops:

Example piling as built-2rev.dwg

February 14, 2008

ASMI, really sorry to you. After i try yesterday night i had find the way your rountine work.its fine and seem to be perfect ! WOW ! is really faster than what i can imagine only is that posibble the result not in block form?

February 14, 2008

ASMI, and if the setting scale for the text height and arrrow size can be ajust then it become really perfect

February 14, 2008

Hi all , i attach one lisp which is similar to ASMI first routine(#7)

I wish that the final result from ASMI routine (#20) can be same as the result using lisp that i attach.which means the scale can be set and i can use a lisp to highlight or edit the integer(because not in Tag form).

I try to mix up two routine but come out error:oops:

February 14, 2008

Ok. I will see it at today evenig.

February 14, 2008

ASMI as usual , you go above and beyond ......

Your helping nature and dedication is very impressive.

February 16, 2008

Try this please. It with block scale, offset distance adjustment and blocks explode:

(defun c:deviation(/ ABPNT ACTDOC BLPATH BSPOS CPT CURANG
	   CURFIL CURPT DEVAL ERRCOUNT EXBL FANG
	   FCOORD FILLST FILLST1 FILLST2 INPT INSBL
	   INSPT MPT OFFLST OLDOFF OLDSCAL OLDVARS
	   PLBLK PPLIST PT1 PT2 PTLST PTSET VALLST
	   VARLST WPT WRKSET OLDCOL XPT)
 (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(not dev:scal)(setq dev:scal 0.5))
(if(not dev:off)(setq dev:off 2.0))
 (setq oldScal dev:scal
oldOff dev:off)
 (setq dev:scal
 (getreal
   (strcat "\nSpecify tags scale <" (rtos dev:scal) ">: ")))
 (if(not dev:scal)
   (setq dev:scal oldScal)
   ); end if
 (setq dev:off
 (getdist
   (strcat "\nSpecify point-tag offset distance <" (rtos dev:off) ">: ")))
 (if(not dev:off)
   (setq dev:off oldOff)
   ); end if
 (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)(assoc 50 filLst1)))
  (while
    (setq curPt
	(getpoint "\nSpecify 'proposed points' or Spacebar to continue > "))
    (setq ppList(append(list(list(car curPt)(cadr curPt)))ppList))
   ); end while
  (if ppList
    (progn
      (princ "\n <<< SELECT BLOCKS >>> ")
      (if
	(setq wrkSet(ssget filLst))
	(progn
	  (setq wrkSet(vl-remove-if 'listp 
                               (mapcar 'cadr(ssnamex wrkSet)))
		fCoord(trans(list(car(cdr(assoc 10 filLst1)))
				 (cadr(cdr(assoc 10 filLst1))))0 1)
		fAng(cdr(assoc 50 filLst1))
		offLst(mapcar
			'(lambda(x)
			   (list(angle fCoord x)(distance x fCoord)))ppList)
		varLst (list "CMDECHO" "OSMODE" "ATTDIA" "ATTREQ")
		oldVars(mapcar 'getvar varLst)
		actDoc(vla-get-ActiveDocument
			(vlax-get-acad-object))
		errCount 0
		); end setq
	  (vla-StartUndoMark actDoc)
	  (mapcar 'setvar varLst '(0 0 0 1))
	  (foreach bl wrkSet
	    (vla-GetBoundingBox
	      (vlax-ename->vla-object bl) 'mPt 'xPt)
	    (setq cPt(mapcar '+ (trans(vlax-safearray->list mPt)0 1)
		       (mapcar '*(mapcar '-
			       (trans(vlax-safearray->list xPt)0 1)
			       (trans(vlax-safearray->list mPt)0 1))
			       '(0.5 0.5 0.0)))
		  insPt(trans(cdr(assoc 10(entget bl)))0 1)
		  curAng(cdr(assoc 50(entget bl)))
		  ptLst(mapcar
			 '(lambda(x)
			    (polar insPt(car x)(cadr x)))offLst)
		  ); end setq
	    (command "_.zoom" "_o" bl "")
	    (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))
		    ); end setq
	      (if
		(and
		 (setq ptSet(ssget "_W" pt1 pt2 curFil))
		 (= 1(sslength ptSet))
		 ); end and
		    (progn
		      (setq wPt(ssname ptSet 0)
			    bsPos(trans(cdr(assoc 10(entget wPt)))0 1)
			    deVal(mapcar '- pt bsPos)
			    inPt(polar pt(angle cPt pt) dev:off)
			    ); end setq
		            (cond
                              ((and
                               (<=(car pt)(car bsPos))
                               (<(cadr pt)(cadr bsPos))
                               ); end and
                              (setq insBl "Deviation_RT")
                              ); end condition #1
                             ((and
                               (>=(car pt)(car bsPos))
                               (>(cadr pt)(cadr bsPos))
                              ); end and
                             (setq insBl "Deviation_LB")
                              ); end condition #2
                             ((and
                              (<(car pt)(car bsPos))
                              (>=(cadr pt)(cadr bsPos))
                             ); end and
                              (setq insBl "Deviation_RB")
                             ); end condition #3
                                     ((and
                              (>(car pt)(car bsPos))
                              (<=(cadr pt)(cadr bsPos))
                             ); end and
                            (setq insBl "Deviation_LT")
                             ); end condition #4
                            ); end cond
		        (if(not(tblsearch "BLOCK" insBl))
                                 (progn
                                   (if
                                     (setq blPath(findfile(strcat insBl ".dwg")))
                              (command "-insert" blPath "_s" dev:scal inPt "0")
                                   (alert(strcat "\n*** File " (strcat insBl ".dwg") " not found! *** "))
                                ); end if
                               ); end progn
                                 (command "-insert" insBl "_s" dev:scal inPt "0")
			  ); end if
			 (setq exBl(entlast)
			       valLst(vl-remove-if
			   '(lambda(x)(/= "AcDbText" (vla-get-ObjectName x)))
			      (vlax-safearray->list
			        (vlax-variant-value
			         (vla-Explode
			           (vlax-ename->vla-object(entlast)))))))
		      (vla-put-TextString(car valLst)(rtos(abs(*(car deVal)1000)) 2 0))
		      (vla-put-TextString(cadr valLst)(rtos(abs(*(cadr deVal)1000)) 2 0))
		      (command "_.erase" exBl "")
		      ); end progn
		      (progn
		       (setq errCount(1+ errCount)
		             oldCol(getvar "CECOLOR")
			     ); end setq
		       (setvar "CECOLOR" "1")
		       (command "_.circle" pt (* 2 dev:scal))
		       (setvar "CECOLOR" oldCol)
		      ); end progn
		); end if
	      ); end foreach
	    (command "_.zoom" "_p")
	    ); 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) " point(s)!"
      "Look for red circles." ))
   ); end if  
 (princ)
 ); end of c:deviation

***** LAST EDIT *****

There is new version without one bug.

Also change blocks to new version:

Example piling as built-2rev.dwg

February 17, 2008

outstanding work asmi

February 17, 2008

Thank you wizman. But I think it's not so good and can include some bugs. I haven't so much time to quality test it.

February 19, 2008

ASMI, what i can say is WoW:shock: ! Amazing:o ! and my Dreams come true!

really thanks to you which have spend your precious time to create this lisp.i think all the guy who need to do point deviation will appreciate your help especially me!

February 19, 2008

Well when dreams come true.

And still replace the declaration of function with it:

(defun c:deviation(/ ABPNT ACTDOC BLPATH BSPOS CPT CURANG
	   CURFIL CURPT DEVAL ERRCOUNT EXBL FANG
	   FCOORD FILLST FILLST1 FILLST2 INPT INSBL
	   INSPT MPT OFFLST OLDOFF OLDSCAL OLDVARS
	   PLBLK PPLIST PT1 PT2 PTLST PTSET VALLST
	   VARLST WPT WRKSET OLDCOL XPT [color="Blue"]*ERROR*[/color])

I have forgotten to make local function *ERROR*, and it can have some consequences.

February 20, 2008

Dear all, after i use the deviation lisp all things seem to be good but i found that one of my drawing some of the point deviation cant come out. i wonder whats is the things/problem that effect the program running on that point which i point with arrrow in attachment ?

Thanks for show me the way and all the help.

Deviation example.dwg

February 20, 2008

This case shows that programs should be tried on real drawings In this case it works as it should work and lacks very simply to correct.

But you should answer two questions.

1) what to do if in a zone of search two or more points get? On the drawing you write that you simply delete superfluous. But the program not the man, for it it is necessary to specify what point to delete: a) near b) far c) first found (any).

2) How much I can reduce a zone of search of a point. At present it was a rectangular 2*2 (2000*2000, 1000 to any side apart point) and it created errors. Now, when I have reduced a zone up to 1*1 (1000*1000, 500 to any side apart point) errors on the given drawing were gone. Can I reduse this zone for example to 0.8*0.8 (maximum deviation 400) or 0.6*0.6 (maximum deviation 300)?

February 20, 2008

And

3) What can I do if not any points. Draw red 'error' circle or draw '0 0' deviation tag?

February 20, 2008

ASMI,

1.)If there is two or more points get,delete the far point used the nearest point.

2.)maximum deviation 300 will do.

3.) If no any point found Draw red 'error' circle as what the existing program running is the best

February 20, 2008

It seems works Ok.

(defun c:deviation(/ ABPNT ACTDOC BLPATH BSPOS CPT CURANG
	   CURFIL CURPT DEVAL ERRCOUNT EXBL FANG
	   FCOORD FILLST FILLST1 FILLST2 INPT INSBL
	   INSPT MPT OFFLST OLDOFF OLDSCAL OLDVARS
	   PLBLK PPLIST PT1 PT2 PTLST PTSET VALLST
	   VARLST WPT WRKSET OLDCOL XPT PLST DELLST
	   *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(not dev:scal)(setq dev:scal 0.5))
(if(not dev:off)(setq dev:off 2.0))
 (setq oldScal dev:scal
oldOff dev:off)
 (setq dev:scal
 (getreal
   (strcat "\nSpecify tags scale <" (rtos dev:scal) ">: ")))
 (if(not dev:scal)
   (setq dev:scal oldScal)
   ); end if
 (setq dev:off
 (getdist
   (strcat "\nSpecify point-tag offset distance <" (rtos dev:off) ">: ")))
 (if(not dev:off)
   (setq dev:off oldOff)
   ); end if
 (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)(assoc 50 filLst1)))
  (while
    (setq curPt
	(getpoint "\nSpecify 'proposed points' or Spacebar to continue > "))
    (setq ppList(append(list(list(car curPt)(cadr curPt)))ppList))
   ); end while
  (if ppList
    (progn
      (princ "\n <<< SELECT BLOCKS >>> ")
      (if
	(setq wrkSet(ssget filLst))
	(progn
	  (setq wrkSet(vl-remove-if 'listp 
                               (mapcar 'cadr(ssnamex wrkSet)))
		fCoord(trans(list(car(cdr(assoc 10 filLst1)))
				 (cadr(cdr(assoc 10 filLst1))))0 1)
		fAng(cdr(assoc 50 filLst1))
		offLst(mapcar
			'(lambda(x)
			   (list(angle fCoord x)(distance x fCoord)))ppList)
		varLst (list "CMDECHO" "OSMODE" "ATTDIA" "ATTREQ" "PDSIZE")
		oldVars(mapcar 'getvar varLst)
		actDoc(vla-get-ActiveDocument
			(vlax-get-acad-object))
		errCount 0
		); end setq
	  (vla-StartUndoMark actDoc)
	  (mapcar 'setvar varLst '(0 0 0 1 0.01))
	  (foreach bl wrkSet
	    (vla-GetBoundingBox
	      (vlax-ename->vla-object bl) 'mPt 'xPt)
	    (setq cPt(mapcar '+ (trans(vlax-safearray->list mPt)0 1)
		       (mapcar '*(mapcar '-
			       (trans(vlax-safearray->list xPt)0 1)
			       (trans(vlax-safearray->list mPt)0 1))
			       '(0.5 0.5 0.0)))
		  insPt(trans(cdr(assoc 10(entget bl)))0 1)
		  curAng(cdr(assoc 50(entget bl)))
		  ptLst(mapcar
			 '(lambda(x)
			    (polar insPt(car x)(cadr x)))offLst)
		  ); end setq
	    (command "_.zoom" "_o" bl "")
	    (foreach pt ptLst
	      (setq pt1(mapcar '- pt '(0.6 0.6 0.0))
		    pt2(mapcar '+ pt '(0.6 0.6 0.0))
		    curFil(list '(0 . "POINT")(assoc 8 filLst2))
		    ); end setq
	      (if
		 (setq ptSet(ssget "_W" pt1 pt2 curFil))
		    (progn
		      (setq pLst(vl-sort(mapcar '(lambda(x)
					    (list(distance pt
					      (cdr(assoc 10(entget x))))x))
				                (vl-remove-if 'listp 
                                                         (mapcar 'cadr(ssnamex ptSet))))
                                            	'(lambda(a b)(<(car a)(car b))))
		            wPt(cadar pLst)

			    bsPos(trans(cdr(assoc 10(entget wPt)))0 1)
			    deVal(mapcar '- pt bsPos)
			    inPt(polar pt(angle cPt pt) dev:off)
			    ); end setq
		      (if(/= 1(sslength ptSet))
			(setq delLst(cdr pLst))
			(foreach dt delLst
			  (command "_.erase"(cadr dt) "")
			  ); end foreach
			); end if
		            (cond
                              ((and
                               (<=(car pt)(car bsPos))
                               (<(cadr pt)(cadr bsPos))
                               ); end and
                              (setq insBl "Deviation_RT")
                              ); end condition #1
                             ((and
                               (>=(car pt)(car bsPos))
                               (>(cadr pt)(cadr bsPos))
                              ); end and
                             (setq insBl "Deviation_LB")
                              ); end condition #2
                             ((and
                              (<(car pt)(car bsPos))
                              (>=(cadr pt)(cadr bsPos))
                             ); end and
                              (setq insBl "Deviation_RB")
                             ); end condition #3
                                     ((and
                              (>(car pt)(car bsPos))
                              (<=(cadr pt)(cadr bsPos))
                             ); end and
                            (setq insBl "Deviation_LT")
                             ); end condition #4
                            ); end cond
		        (if(not(tblsearch "BLOCK" insBl))
                                 (progn
                                   (if
                                     (setq blPath(findfile(strcat insBl ".dwg")))
                              (command "-insert" blPath "_s" dev:scal inPt "0")
                                   (alert(strcat "\n*** File " (strcat insBl ".dwg") " not found! *** "))
                                ); end if
                               ); end progn
                                 (command "-insert" insBl "_s" dev:scal inPt "0")
			  ); end if
			 (setq exBl(entlast)
			       valLst(vl-remove-if
			   '(lambda(x)(/= "AcDbText" (vla-get-ObjectName x)))
			      (vlax-safearray->list
			        (vlax-variant-value
			         (vla-Explode
			           (vlax-ename->vla-object(entlast)))))))
		      (vla-put-TextString(car valLst)(rtos(abs(*(car deVal)1000)) 2 0))
		      (vla-put-TextString(cadr valLst)(rtos(abs(*(cadr deVal)1000)) 2 0))
		      (command "_.erase" exBl "")
		      ); end progn
		      (progn
		       (setq errCount(1+ errCount)
		             oldCol(getvar "CECOLOR")
			     ); end setq
		       (setvar "CECOLOR" "1")
		       (command "_.circle" pt dev:off)
		       (setvar "CECOLOR" oldCol)
		      ); end progn
		); end if
	      ); end foreach
	    (command "_.zoom" "_p")
	    ); 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) " point(s)!"
      "Look for red circles." ))
   ); end if  
 (princ)
 ); end of c:deviation

Test on my PC:

Deviation example_New.dwg

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

jason tay

jason tay

jason tay

jason tay

jason tay

ASMI

PS_Port

ASMI

wizman

ASMI

jason tay

ASMI

jason tay

ASMI

ASMI

jason tay

ASMI

Join the conversation

jason tay

jason tay

Tutorials

Forums

Activity