As-Built Deviation

[Demesne]

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.

 

Thanks

Demesne

DevBox.LSP

Sample.dwg

Deviation_BOX.dwg

Edited July 11, 2018 by Demesne
Files now in v2013 format. Deviation_BOX.dwg amended.

[BIGAL]

Have a look at this for the 4 corner arrows etc, I know in CIV3d tbm labeling is a pain.

 

http://www.cadtutor.net/forum/showthread.php?104628-Using-a-text-file-to-add-and-manipulate-Dynamic-Blocks

[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

[hanhphuc]

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 July 11, 2018 by hanhphuc
code added & fixed osmode bug

[Demesne]

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 July 11, 2018 by Demesne
Code updated to include hanhphuc suggestion.

[hanhphuc]

Demesne said:

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)

...

 

 

(defun +rtos (x u p)
 (strcat (if (> x 0)
    "+"
    ""
    )
  (rtos x u p)
  )
 )

(+rtos 10. 2 0)
"+10"
(+rtos -10. 2 0)
"-10"

 

Edited December 26, 2019 by hanhphuc
removed BBCode tags

[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

[ronjonp]

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 July 11, 2018 by ronjonp

[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.

[hanhphuc]

ronjonp said:

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] 

automated multiply formula in field seems not working in windows x64 tested x86(32bit) 

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

 

ONLY WORKING FOR WINDOWS x86 (32bit)

(vl-load-com)
(defun c:devtest2 ( / *error* p1 p2 p3 ex del obj str mtx )
(setvar 'fielddisplay 0)
(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 . 8)
		   (mapcar '(lambda (a b)(cons a (set b (trans (eval b) 1 0)))) '(10 11) '(p1 p2))))
      obj (vlax-ename->vla-object en)
      p2 (mapcar '(lambda (a b)  (* (+ a b) 0.5)) p1 p2)
      )
(setq p3 (getpoint (trans p2 0 1) "\nSpecify leader landing location: "))
(setq p3 (trans p3 1 0)
      del (vlax-get obj 'delta)
      ;str (XY->field obj 2 3 0)
       str (XY->field32 obj 2 0 1000 0) ; for acad2007 - windows x86 (32bit)

)
)
(progn
(vla-addleader *msps* (vlax-safearray-fill (vlax-make-safearray 5 '(0 . 5)) (append p2 p3 ))
(progn
(setq mtx (vla-addmtext
    *msps*
    (vlax-3d-point p3)
    (* (+ 5 (apply 'max (mapcar '(lambda (x) (strlen (rtos x 2 3))) del))) (getvar 'textsize))
    str
    )
     )
;;; Text justification revised using vla method 
(mapcar '(lambda (a b)(vlax-put mtx 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)

)



;;; Windows x86 (32bit)
;;; XY->FIELD32 : 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	- multiplier factor (credits: Inspired by Lee Mac's fieldmath)
;;;mode	- (Points,*Text,Arc,Circle,Ellipse & Delta ) 0=default
;;;	  (Line,Arc,Ellipse) 1=Startpoint,2=Endpoint



;V1.1: fix to support start&endpoints, maintains 5 arguments
(defun XY->field32 (obj u prec sc mode / prop pfx xy )

(setq xy  0  ;;;;user favorite prefix format default 0=E&N ,1=X&Y 
      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 January 21, 2020 by hanhphuc
removed BBCode tags