calculate new elevetion text lisp

[Guest]

Hi . I have a landsurvey problem.I want insert a new elevetion text for my measure points without change the origial elevetion.

I want to set the +0.000  on point 19 with original elevetion 123.500  and minus  123.500  from all others  selected elevetions and insert  the new elenetion for example +0.10 or -0.25 etc

 

Thanks

 

test.dwg

Edited November 28, 2021 by prodromosm

[Guest]

I find BIGAL code here https://www.cadtutor.net/forum/topic/45560-add-or-substract-from-a-value/ ,and i change the calculation to subtrac the elevetion

 

Is it possible to work with attribiute text and insert a new text after the calculation without change the original elevetion in the block ?

 

Thanks

 

; Adds a fixed amount to a number
;(PRINC "\nTO USE JUST TYPE A2L or A2LM for multiple ")
;(setvar "cmdecho" 1)
(setq olddimzin (getvar "Dimzin"))
(setvar "dimzin" 0)
(DEFUN c:A2L ()
(setq v2 (getreal "\nEnter ht adjustment "))
(setq test 1)
(while (= test 1)
     (setq en1 (car (entsel "\nSelect text number:" )))
      (if (/= en1 nil)
       (progn
       (setq el1 (entget en1))
       (setq v1 (atof (cdr (assoc 1 el1))))
       (setq a (- v1 v2))
       (setq b (rtos a 2 3))
       (setq el (subst (cons 1 b) (assoc 1 el1) el1))
       (entmod el)
;        (entupd en1)
       );progn
      (princ "\nplease pick again"); else
    );if
); while true
(setq el nil)
(setq en nil)
(setq a nil)
(setq v1 nil)
(setvar "cmdecho" 1)
(setvar "dimzin" olddimzin)
(princ)
); END a2l DEFUN
(defun c:A2LM ()
(setq v2 (getreal "\nEnter ht adjustment "))
(setq ss (ssget (list (cons 0 "Text"))))
(setq len (sslength ss))
(setq x 0)
(repeat len
(setq en1 (ssname ss x))
       (setq el1 (entget en1))
       (setq v1 (atof (cdr (assoc 1 el1))))
       (setq a (- v1 v2))
       (setq b (rtos a 2 3))
       (setq el (subst (cons 1 b) (assoc 1 el1) el1))
       (entmod el)
(setq x (+ x 1))
); repeat
(setq el nil
     ss nil)
(setq en nil)
(setq a nil)
(setq v1 nil)

(setvar "dimzin" olddimzin)
(setvar "cmdecho" 1)
(princ)
); END a2lm DEFUN

 

[Emmanuel Delay]

See if you're happy with this.

 

Command CNE

 

Then select block with id 19, which will be the +0.000 base.

The value is set in attribute DESC (is this okay?).

You just have to drag that attribute to a good position.

 

 
  (vl-load-com)
  
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; Get Attribute Value  -  Lee Mac
;; Returns the value held by the specified tag within the supplied block, if present.
;; blk - [vla] VLA Block Reference Object
;; tag - [str] Attribute TagString
;; Returns: [str] Attribute value, else nil if tag is not found.
(defun LM:vl-getattributevalue ( blk tag )
    (setq tag (strcase tag))
    (vl-some '(lambda ( att ) (if (= tag (strcase (vla-get-tagstring att))) (vla-get-textstring att))) (vlax-invoke blk 'getattributes))
)
 
;; Set Attribute Value  -  Lee Mac
;; Sets the value of the first attribute with the given tag found within the block, if present.
;; blk - [vla] VLA Block Reference Object
;; tag - [str] Attribute TagString
;; val - [str] Attribute Value
;; Returns: [str] Attribute value if successful, else nil.
(defun LM:vl-setattributevalue ( blk tag val )
    (setq tag (strcase tag))
    (vl-some
       '(lambda ( att )
            (if (= tag (strcase (vla-get-tagstring att)))
                (progn (vla-put-textstring att val) val)
            )
        )
        (vlax-invoke blk 'getattributes)
    )
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
  
 ;; Calculate New Elevetion 
 (defun c:cne ( / ss source i baseElv elv elvDiff)
  ;; user selects base block 
  (setq source (car (entsel "\nSelect the base block.  This blocks' elevation will be the +0.000 base: ")))
  (setq baseElv (atof (LM:vl-getattributevalue (vlax-ename->vla-object source) "ELEV")))
  ;; select all elevation blocks
  (setq ss (ssget "_X" (list (cons 0 "INSERT") (cons 2 "AnnotPoint"))))
  (setq i 0)
  (repeat (sslength ss)
    (setq elv (atof (LM:vl-getattributevalue (vlax-ename->vla-object (ssname ss i)) "ELEV")))
	;; calculate difference.  Force a "+" sign if not negative.
	(if (< (- baseElv elv)  0.0)
	  (setq elvDiff (vl-princ-to-string (- baseElv elv)))
	  (setq elvDiff (strcat "+" (vl-princ-to-string (- baseElv elv))))
	)
	(LM:vl-setattributevalue (vlax-ename->vla-object (ssname ss i)) "DESC" elvDiff)
	(setq i (+ i 1))
  )
 )

 

[Guest]

Nice job  Emmanuel Delay. Thanks 

 

But if i want to change specific points and not all points how to do it?

Edited November 29, 2021 by prodromosm

[Emmanuel Delay]

Then you remove the "_X".  Then you get to select the blocks.

 

Change these lines:

 

  ;; select all elevation blocks
  (princ "\nSelect specific points blocks: ")
  (setq ss (ssget (list (cons 0 "INSERT") (cons 2 "AnnotPoint"))))

 

Edited November 29, 2021 by Emmanuel Delay

[Guest]

Hi Emmanuel Delay i want to ask for some changes

 

1) The start 0.00 i want ot have 2 decimals not 0.0

2) All the calculations to have  2 decimals not 3

 

Thansk

Edited November 29, 2021 by prodromosm

[Guest]

ok i fix it. Thanks  Emmanuel Delay

[Emmanuel Delay]

You can use RTOS for the fixed number of decimals.

 

 ;; Calculate New Elevetion 
 (defun c:cne ( / ss source i baseElv elv elvDiff)
  ;; user selects base block 
  (setq source (car (entsel "\nSelect the base block.  This blocks' elevation will be the +0.000 base: ")))
  (setq baseElv (atof (LM:vl-getattributevalue (vlax-ename->vla-object source) "ELEV")))
  ;; select all elevation blocks
  (princ "\nSelect specific points blocks: ")
  (setq ss (ssget (list (cons 0 "INSERT") (cons 2 "AnnotPoint"))))
  (setq i 0)
  (repeat (sslength ss)
    (setq elv (atof (LM:vl-getattributevalue (vlax-ename->vla-object (ssname ss i)) "ELEV")))
    ;; calculate difference.  Force a "+" sign if not negative.
    (if (< (- baseElv elv)  0.0)
      (setq elvDiff (rtos (- baseElv elv) 2 2))
      (setq elvDiff (strcat "+" (rtos (- baseElv elv) 2 2)))
    )
    (LM:vl-setattributevalue (vlax-ename->vla-object (ssname ss i)) "DESC" elvDiff)
    (setq i (+ i 1))
  )
 )

 

[Guest]

Yes. Thanks

[Guest]

Hi Emmanuel Delay .I want to ask you samething similar with the previous post.

 

in the previous example the elevetion tag in the attribiute have  numbers with 3 decimals. Is any way to change the previous code not to calculate new elevetion this time to replace all the elevetion tags with  the same elevetion but with 2 decimals .  for example the point 3 have 123.317 --> 123.32

 

Thanks

[Emmanuel Delay]

Sure.

Do you mean this?

 

I added Rounding functions (from Lee Mac); I RTOS just cuts off the digit, but you want it rounded up/down.

This code requires the functions I put in the previous comments 

 

;; http://www.lee-mac.com/round.html

;; Round Multiple  -  Lee Mac
;; Rounds 'n' to the nearest multiple of 'm'
(defun LM:roundm ( n m )
    (* m (fix ((if (minusp n) - +) (/ n (float m)) 0.5)))
)

;; Round To  -  Lee Mac
;; Rounds 'n' to 'p' decimal places
(defun LM:roundto ( n p )
    (LM:roundm n (expt 10.0 (- p)))
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 

;; Elevation Two Digits
(defun c:etd ( / ss i baseElv elv)  
  (setq ss (ssget (list (cons 0 "INSERT") (cons 2 "AnnotPoint"))))
  (setq i 0)
  (repeat (sslength ss)
    (setq elv (atof (LM:vl-getattributevalue (vlax-ename->vla-object (ssname ss i)) "ELEV")))
    (LM:vl-setattributevalue (vlax-ename->vla-object (ssname ss i)) "ELEV" (rtos (LM:roundto elv 2) 2 2))
  	(setq i (+ i 1))
  )
)  

 

[Guest]

The code works fine .The only error calculation i find is in number 11 with elen 122.945 gives me 122.94 . I beleve that the correct is 122.95. All the other numbers ifor example 16  have elev 123.435 --> 123.44 if the third desc is 5 round up .