Jump to content
Demesne

As-Built Deviation

Recommended Posts

Demesne
Posted (edited)

Hello

 

I've been trying unsuccessfully to modify ASMI's Deviation_Tag routine which produces x,y deviations between two picked points. Rather than have the results displayed with arrows I'd like to have them displayed in a box with a +/- prefix and also have the option to set a scale when starting the lisp.

 

ASMI's Deviation_Tag.lsp references four drawing files that contain the arrows and attributes definitions, I have created my own block (Deviation_BOX.dwg) and I can simply change the code to load this file (same file for all four quadrants - not ideal, but I'm not that clued up).

 

The link above is to the original files and the attached shows my butchered effort. If anyone is able to help me with the +/- prefix and the scale I'd be most grateful.

 

What would be a bonus, but not a necessity just now, would be an arrow from the closest corner of the block to the as-built point (second pick point). This could be either of the four corners depending on where the block was placed.

 

I'm stuck with this one. :unsure:

 

Thanks

Demesne

DevBox.LSP

Sample.dwg

Deviation_BOX.dwg

Edited by Demesne
Files now in v2013 format. Deviation_BOX.dwg amended.

Share this post


Link to post
Share on other sites
Demesne

Hi BIGAL

 

I'm not sure if I'm missing something but I couldn't find anything on that post that helped. I'm just trying to pick two points (one a design position the other an as-built) and have the deviation between the two points drawn in a box as per the Sample.dwg above. If I have missed something in the link you sent, it's probably because I'm no lisp expert.

 

Thanks

Share this post


Link to post
Share on other sites
hanhphuc
Posted (edited)
results displayed with arrows I'd like to have them displayed in a box with a +/- prefix and also have the option to set a scale

 

hi not every has newer version cad like yours so can't test your block.

 

but IMO it should display negative by removing abs

 

i.e: (rtos (abs (.....))) ; remove absolute number

 

(rtos(*(car deVal)1000)2 0)
(rtos(*(cadr deVal)1000)2 0))

 

FWIW i recall it was a bit similar 'asbuilt?' (theoretical & actual point)? without using block.

 

It uses TEXTSIZE as associative scale.

 

here i fixed minor 'osmode bug

(defun c:devtest (/ p1 p2 p3 *error* var os osaved delta _mirror s ip)

[color="green"] ;sub-functions to be included here 
;[b]defun _mirror & defun delta[/b]
 

;to adjust scale,
;command: [b]TEXTSIZE[/b] [/color]
 (defun *error* (msg)
   (if	var
     (mapcar 'setvar var osaved)
     )
   )
 (if (not (tblsearch "LAYER" "DIFF"))
   (vl-cmdf "-Layer" "m" "DIFF" "")
   )
 (setq	var    '(osmode angbase angdir cmdecho clayer mirrtext)
osaved (mapcar 'getvar var)
os     (car osaved) ; or favourite osmode = 40
)
 (mapcar 'setvar var (list os (/ pi 2.0) 1 0 "DIFF" 0))
 (terpri)
 (while (and (setq p1 (getpoint "\rTheoretical point..       "))
      (setq p2 (getpoint p1 "\rActual point..            "))
      (setvar 'osmode 0)
      (setq p3 (getpoint p2 "\rPlacing arrow..           "))
      )
   ([color="blue"]delta[/color] p1 p2 p3)
   (setvar 'osmode os)
   )
 
 (if osaved
   (mapcar 'setvar var osaved)
   )
 
 (princ)
 )

 

BIGAL will assist you if regarding Block issue, good luck

Edited by hanhphuc
code added & fixed osmode bug

Share this post


Link to post
Share on other sites
Demesne
Posted (edited)

DWG files re-uploaded as v2013. Thanks for pointing that out. I've just migrated to a new laptop (clearly not very well).

 

I've stripped out abs and reversed the two variables ppPos and bsPos so that the deviations show as from proposed to design rather than from design to proposed. This works and does show the negative symbol where needed but I'm stumped on how to put a plus symbol on there to show a positive deviation - I know that it is assumed that numbers without a sign are positive, but I just think it would look better in this instance.

 

This is where I'm at:

 

; Original code by ASMI (Deviation_Tag.LSP) - CADTutor
; Badly butchered by Demesne 11/07/18

(defun c:devbox( / *error* oldEcho ppPos bsPos deVal insBl)

  (defun *error* (msg)
    (setvar "CMDECHO" oldEcho)
  ); end of *error*
  
  (defun +rtos (x u p)
     (strcat 
    (if (> x 0)
      "+"
      "")
    (rtos x u p)
  )
   )
 
  (setq oldEcho(getvar "cmdecho"))
  (setvar "CMDECHO" 0)
  
  (setq bsPos(getpoint "\nPick proposed position > "))
  (setq ppPos(getpoint "\nPick as-built position > "))
  
  (setq deVal(mapcar '- ppPos bsPos))
  
  (setq insBl "Deviation_BOX")
  
  (if
    (not(tblsearch "block" insBl))
    (progn
      (if
       (setq blPath(findfile(strcat insBl ".dwg")))
    (command "-insert" blPath "_s" "1" pause "0"
 	  (+rtos(*(car deVal)1000)2 0)
 	  (+rtos(*(cadr deVal)1000)2 0))
       (alert(strcat "\n*** File " (strcat insBl ".dwg") " not found! *** "))
      ); end if
    ); end progn
    (command "-insert" insBl "_s" "1" pause "0"
      (+rtos(*(car deVal)1000) 2 0)
      (+rtos(*(cadr deVal)1000) 2 0))
  ); end if
  
 (setvar "cmdecho" oldEcho)
 (princ)
); end of c:devbox

Edited by Demesne
Code updated to include hanhphuc suggestion.

Share this post


Link to post
Share on other sites
hanhphuc
DWG files re-uploaded as v2013. Thanks for pointing that out. I've just migrated to a new laptop (clearly not very well).

 

I'm stumped on how to put a plus symbol on there to show a positive deviation

 

; Original code by ASMI (Deviation_Tag.LSP) - CADTutor
; Badly butchered by Demesne 11/07/18

(defun c:devbox( / *error* oldEcho ppPos bsPos deVal insBl)

...

 

([color="blue"]defun[/color] [b]+rtos[/b] (x u p)
 ([color="blue"]strcat[/color] ([color="blue"]if[/color] ([color="blue"]>[/color] x 0)
    [color="purple"][b]"+"
    ""[/b][/color]
    )
  ([color="blue"]rtos[/color] x u p)
  )
 )

([color="blue"]+rtos[/color] 10. 2 0)
[color="purple"]"+10"[/color]
([color="blue"]+rtos[/color] -10. 2 0)
[color="purple"]"-10"[/color]

Share this post


Link to post
Share on other sites
Demesne

Thanks hanhphuc. I've added your code to my code above. Your help is greatly appreciated.

 

I'll have to have a play with trying to show an arrow from the closest corner of the box to the as-built point. Suggestions welcome ;)

Share this post


Link to post
Share on other sites
ronjonp
Posted (edited)

Why don't you use an mleader? Here's some sample code ( assumes your current mleaderstyle has text )

(defun c:foo (/ p1 p2 p3 r)
 (cond	((and (setq p1 (getpoint "\nPick first point:"))
      (setq p2 (getpoint "\nPick second point:"))
      (setq r (mapcar '(lambda (x)
			 (strcat (cond ((minusp x) "")
				       ("+")
				 )
				 (rtos (* x 1000) 2 0)
			 )
		       )
		      (mapcar '- p1 p2)
	      )
      )
 )
 (entmakex (list '(0 . "line") '(8 . "deviation") '(62 .  (cons 10 p1) (cons 11 p2)))
 (setq p2 (polar p1 (angle p1 p2) (/ (distance p1 p2) 2.)))
 (if (setq p3 (getpoint p2 "\nSpecify leader landing location: "))
   (command "_.mleader" p2 p3 (strcat "E " (car r) "\\PN " (cadr r)))
 )
)
 )
 (princ)
)

Edited by ronjonp

Share this post


Link to post
Share on other sites
hanhphuc
Thanks hanhphuc. I've added your code to my code above. Your help is greatly appreciated.

 

I'll have to have a play with trying to show an arrow from the closest corner of the box to the as-built point. Suggestions welcome ;)

 

no worries.

putting arrow thanks ronjonp has shared his idea :)

though ver 2007 does not have command mleader, IMO qleader could do the same.

Share this post


Link to post
Share on other sites
hanhphuc
Posted (edited)
Why don't you use an mleader? Here's some sample code ( assumes your current mleaderstyle has text )

(defun c:foo (/ p1 p2 p3 r)....
)

 

 

Nice idea. since the LINE being created, if only working in WCS i have an idea using FIELD - Line's delta property :)

 

v2007 using qleader instead of mleader.

 

[EDIT]

since line's delta property is referenced to UCS, i.e: The deviations value can be updated while working in different UCS or WCS upon command REGEN

- trans UCS & output 'str' to be evaluated in 'and' expression

- Mtext justification entmod didn't work after addleader due to entlast was not MTEXT


(vl-load-com)

(defun c:[b]devtest2[/b] ( / *error* p1 p2 p3 ex del obj [color="red"]str mtx[/color] )
 
(setq *msps* ((lambda	(doc)
	  (foreach x '(ActiveDocument ActiveLayout Block) (setq doc (vlax-get doc x)))
	  )
	 (vlax-get-acad-object)
	 )
     *error*  '((msg) (princ "\n*cancel*"))
     )

 
(while
 (and	(setq p1 (getpoint "\nPick 1st point.. "))
(setq p2 (getpoint "\nPick 2nd point.. "))
(setq en (entmakex (vl-list* '(0 . "LINE") '(8 . "DEVIATION") '(62 . 
		   (mapcar ''((a b)(cons a (set b ([color="blue"]trans[/color] (eval b) 1 0)))) '(10 11) '(p1 p2))))
      obj (vlax-ename->vla-object en)
      p2 (mapcar ''((a b)  (* (+ a b) 0.5)) p1 p2)
      )
(setq p3 (getpoint (trans p2 0 1) "\nSpecify leader landing location: "))
(setq p3 ([color="blue"]trans[/color] p3 1 0)
      del (vlax-get obj 'delta)
      [color="red"]str[/color] ([color="blue"]XY->field[/color] obj 2 0 1000 0))
)
(progn
(vla-addleader *msps* (vlax-safearray-fill (vlax-make-safearray 5 '(0 . 5)) (append p2 p3 ))
(progn
(setq [color="red"]mtx[/color] (vla-addmtext
    *msps*
    (vlax-3d-point p3)
    (* (+ 3 (apply 'max (mapcar ''((x) (strlen (rtos x 2 3))) del))) (getvar 'textsize))
    str
    )
     )
[color="green"];;; Text justification revised using vla method [/color]
(mapcar '(lambda (a b)(vlax-put [color="red"]mtx[/color] a b))
  '(attachmentpoint Rotation)
  (list (if (car (mapcar '< p2 p3))
    4
    6
    )
   (- (* 2. pi) (angle '(0. 0. 0.) (getvar 'ucsxdir)))
   )
)
 mtx
 )
acLineWithArrow
)

) ;progn
 
) ; while

(*error* nil)
(princ)

)




[color="green"];;; XY->FIELD : generates quick XY point field code - hanhphuc
;;;obj 	- VLA object
;;;u 	- units 1=Scientific 2=Decimal 3=Engineering 4=Architectural 5=Fractional 6=Current
;;;prec - precision 
;;;sc	- [color="red"]multiplier factor[/color] (credits: Inspired by Lee Mac's [url="http://lee-mac.com/fieldmath.html"]fieldmath[/url])
;;;mode	- (Points,*Text,Arc,Circle,Ellipse & Delta ) 0=default
;;;	  (Line,Arc,Ellipse) 1=Startpoint,2=Endpoint

[/color]

[color="green"];V1.1: fix to support start&endpoints, maintains 5 arguments[/color]
(defun [b]XY->field[/b] (obj u prec sc mode / prop pfx xy )

(setq xy [color="red"] 0[/color]  [color="green"];;;;user favorite prefix format default 0=E&N ,1=X&Y[/color] 
      pfx (if (zerop xy)
     '("E " "N ")
     '("X " "Y ")
     )
      )
 (if (and (setq prop (nth mode (vl-remove nil (mapcar '(lambda (x)
			 (if
			  (vlax-property-available-p obj x)
			  x
			  )
			 )
		       '("Coordinates" "Center" "InsertionPoint" "TextPosition" "Origin" "Delta" "StartPoint" "EndPoint")
		      )
		)
	 )
	 )
   (not (vlax-erased-p obj))
   (<= (length (vlax-get obj prop)) 3)
   )
   (apply 'strcat
   (mapcar '(lambda (a b c)
	      (strcat a
		      "%<\\AcExpr ("(rtos (float sc) u prec)" * %<\\AcObjProp Object(%<\\_ObjId "
		      (itoa (vla-get-objectid obj))
		      ">%)."
		      prop
		      " \\f \"%lu"(itoa u)"%pt"
		      c
		      "%pr8\">%"
		      ") \\f \"%lu"(itoa u)"%pt"
		      c
		      "%qf1%pr"(itoa prec)"\">%"
		      " \n"
		      )
	      )
	   (if (= prop "Delta") (mapcar '(lambda(x)(strcat "d" x)) pfx ) pfx )
	   (vlax-get obj prop)
	   '("1" "2")
	   )
   )
   )
 )

Edited by hanhphuc
fixed sub-function to support start & end points

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

×