Jump to content

calculate new elevetion text lisp


prodromosm
 Share

Recommended Posts

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

test.dwg

Edited by prodromosm
Link to comment
Share on other sites

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

 

Link to comment
Share on other sites

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

 

Link to comment
Share on other sites

Nice job  Emmanuel Delay. Thanks  😀😀

 

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

Edited by prodromosm
  • Like 1
Link to comment
Share on other sites

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 by Emmanuel Delay
Link to comment
Share on other sites

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 by prodromosm
Link to comment
Share on other sites

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

 

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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

 

Link to comment
Share on other sites

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 .

 

 

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

 Share

×
×
  • Create New...