Piling As built

[jason tay]

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?

[ASMI]

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.

[jason tay]

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

[jason tay]

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

[jason tay]

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

[jason tay]

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?

[jason tay]

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

[jason tay]

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:

V1.DWG

V2.DWG

V3.DWG

V4.DWG

ECC.LSP

[ASMI]

Ok. I will see it at today evenig.

[PS_Port]

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

Your helping nature and dedication is very impressive.

[ASMI]

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:

Deviation_LB.dwg

Deviation_LT.dwg

Deviation_RB.dwg

Deviation_RT.dwg

Example piling as built-2rev.dwg

[wizman]

outstanding work asmi

[ASMI]

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.

[jason tay]

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!

[ASMI]

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.

[jason tay]

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

[ASMI]

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

[ASMI]

And

 

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

[jason tay]

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

[ASMI]

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