Jump to content

Specify the height mark at the base point of the blocks

Nikon

By Nikon
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

Nikon Proficient

Nikon

Posted
Posted (edited)

I know that there are many great programs on this topic.
This code allows you to mark the height at the specified points.
Is it possible to select all the blocks and get a height mark at the base point of the block?
To begin with, specify a base point of 0.000.
Move the text up 600 mm from the insertion point.  

;; setting elevation markers by Y with offset the text up by 600 mm from the specified point

(defun fix-zeros (s)
  (if (not (vl-string-search "." s))
    (setq s (strcat s ".000"))
    (while (< (strlen (substr s (+ 2 (vl-string-search "." s)))) 3)
      (setq s (strcat s "0"))
    )
  )
  s
)

(defun c:MarkElevOff (/ basePt pts pt y0 y1 delta str basePtUp ptUp)
  (prompt "\nSelect the starting point ( 0.000): ")
  (setq basePt (getpoint))
  (setq y0 (cadr basePt))

  (setq basePtUp (list (car basePt) (+ (cadr basePt) 600) (caddr basePt)))
  (entmakex (list
    (cons 0 "TEXT")
    (cons 10 basePtUp)
    (cons 40 250)
    (cons 1 "0.000")
    (cons 50 0.0)
    (cons 7 (getvar "TEXTSTYLE"))
    (cons 8 (getvar "CLAYER"))
  ))

  (prompt "\nSelect the remaining points for the marks (ENTER to finish): ")
  (setq pts '())
  (while (setq pt (getpoint "\nSpecify a point: "))
    (setq pts (cons pt pts))
    (setq y1 (cadr pt))
    (setq delta (/ (- y1 y0) 1000.0)) 
    (if (>= delta 0)
      (setq str (strcat "+" (fix-zeros (rtos delta 2 3))))
      (setq str (fix-zeros (rtos delta 2 3)))
    )
    (setq ptUp (list (car pt) (+ (cadr pt) 600) (caddr pt)))
    (entmakex (list
      (cons 0 "TEXT")
      (cons 10 ptUp)
      (cons 40 250)
      (cons 1 str)
      (cons 50 0.0)
      (cons 7 (getvar "TEXTSTYLE"))
      (cons 8 (getvar "CLAYER"))
    ))
    (command "_.REGEN") 
  )
  (princ)
)

 

MarkElevOff.dwg

 

text offset.png

Edited by Nikon
GLAVCVS Proficient

GLAVCVS

Posted
Posted (edited)

Hi

Try it 

(defun c:MarkElevOff1 (/ cj cj1 e cotabas cota n #etq etq dmzAnt)
  (setq dmzAnt (getvar "DIMZIN"))
  (setvar "DIMZIN" 0) 
  (princ "\nSelect all blocks... ") 
  (if (setq cj (ssget '((0 . "INSERT"))))
    (progn
      (while (setq e (ssname cj (setq n (if n (1+ n) 0))))
	(if (= (cdr (assoc 2 (entget e))) "*U3")
	  (progn
	    (entmakex
	      (list
	        (cons 0 "TEXT")
	        (cons 10 (list (car (setq cotabas (cdr (assoc 10 (entget e))))) (+ (cadr cotabas) 600)))
	        (cons 40 250)
	        (cons 1 "0.000")
	        (cons 50 0.0)
	        (cons 7 (getvar "TEXTSTYLE"))
	        (cons 8 (getvar "CLAYER"))
	      )
	    )
	  )	
        )		      
      )
      (setq n nil)
      (while (setq e (ssname cj (setq n (if n (1+ n) 0))))
	(if (= (cdr (assoc 2 (entget e))) "*U4")
	  (progn
	    (setq cota (cdr (assoc 10 (entget e)))
		  etq (if (minusp (setq #etq (/ (- (cadr cota) (cadr cotabas)) 1000.0)))
		        (rtos #etq 2 3)
		        (strcat "+" (rtos #etq 2 3))
		      )
            )
	    (entmakex
	      (list
	        (cons 0 "TEXT")
	        (cons 10 (list (car cota) (+ (cadr cota) 600)))
	        (cons 40 250)
	        (cons 1 etq)
	        (cons 50 0.0)
	        (cons 7 (getvar "TEXTSTYLE"))
	        (cons 8 (getvar "CLAYER"))
	      )
	    )
	  )	
        )		      
      )
      (setvar "DIMZIN" dmzAnt)
    )
  )
  (princ)
)

 

Edited by GLAVCVS
  • Like 1
GLAVCVS Proficient

GLAVCVS

Posted
Posted

Select all blocks, including the base point.

It should work

GLAVCVS Proficient

GLAVCVS

Posted
Posted

And.... of course: the blocks must always be "*U3" and "*U4"

  • Thanks 1
Nikon Proficient

Nikon

Posted
  • Author
Posted
49 minutes ago, GLAVCVS said:

Hi

Try it 

(defun c:MarkElevOff1 (/ cj cj1 e cotabas cota n #etq etq dmzAnt)

Hello and thank you, but unfortunately the code returns an error: invalid argument type: numberp: nil

GLAVCVS Proficient

GLAVCVS

Posted
Posted

I tried it on your drawing and it worked.

I'll take a look when I get home.

GLAVCVS Proficient

GLAVCVS

Posted
Posted

If you have tried it with a different drawing, you should attach it.

Nikon Proficient

Nikon

Posted
  • Author
Posted (edited)
36 minutes ago, GLAVCVS said:

If you have tried it with a different drawing, you should attach it.

It turns out that the blocks did not need to be given other names.

I tried again and the code worked great, thanks a lot... good luck...

 

Edited by Nikon
  • Like 1
Nikon Proficient

Nikon

Posted
  • Author
Posted
23 hours ago, GLAVCVS said:

And.... of course: the blocks must always be "*U3" and "*U4"

@GLAVCVS 
Please explain, if it's not difficult for you, will this code not work if the blocks have a different name?   "*U3" and "*U4" are for any 2 block names, I was wondering, I tried renaming my blocks and the code didn't work...

GLAVCVS Proficient

GLAVCVS

Posted
Posted

For it to work with all blocks, you'd need to establish a rule that always applies. Then, adapt the code to those rules.
With the current code, if you change the name and the block is different, it might not work as expected.

  • Thanks 1
GLAVCVS Proficient

GLAVCVS

Posted
Posted

The most important of these conditions is that the place where the text is to be placed remains y+600 and that the name of the block that marks the base point is unique and different from the rest of the blocks.

  • Thanks 1
GLAVCVS Proficient

GLAVCVS

Posted
Posted

Then you will only have to change the references to the old blocks in the code for the new ones.

  • Thanks 1
BIGAL Grand Master

BIGAL

Posted
Posted (edited)

If you select a block you can get two things its effective name and the name of the block, as mentioned often a block name becomes *U23 but it has an effective name still. So the way around it is to over select using SSget with "INSERT" and check the blocks "Effective name" matches the first block picked.

 

Using dumpit on a dynamic block 2 properties

;   EffectiveName (RO) = "TA-WINDOW"
;   Name = "*U308"

Edited by BIGAL
  • Thanks 1
Nikon Proficient

Nikon

Posted
  • Author
Posted (edited)

@GLAVCVS @BIGAL  thank you very much. Now I understand this topic.

The EffectiveName (RO) for the dynamic block is set by the user,

and the Name = "*U3" is assigned by the Autocad.

11 hours ago, GLAVCVS said:

Then you will only have to change the references to the old blocks in the code for the new ones.

Is it possible to ignore the Name in the code and execute the command for the selected blocks?
This code shows the EffectiveName and Name of the selected dynamic block.: 

(defun c:BlockNames-Txt (/ ent obj inspt name effname dx dy)
  (vl-load-com)
  (if (setq ent (car (entsel "\nSelect a block: ")))
    (progn
      (setq obj (vlax-ename->vla-object ent))
      (setq name (vla-get-Name obj))
      (setq effname (vla-get-EffectiveName obj))
      (setq inspt (vlax-get obj 'InsertionPoint))
      ;; Text offset from the base point of the block (can be changed at will)
      (setq dx 20.0) 
      (setq dy 20.0) 

      (entmakex
        (list
          (cons 0 "TEXT")
          (cons 8 (getvar "CLAYER")) 
          (cons 10 (list (+ (car inspt) dx) (+ (cadr inspt) dy) (caddr inspt)))
          (cons 40 2.5) 
          (cons 1 (strcat "Name: " name))
        )
      )

      (entmakex
        (list
          (cons 0 "TEXT")
          (cons 8 (getvar "CLAYER"))
          (cons 10 (list (+ (car inspt) dx) (+ (cadr inspt) (* 2 dy)) (caddr inspt)))
          (cons 40 2.5)
          (cons 1 (strcat "EffectiveName: " effname))
        )
      )
      (princ (strcat "\nName: " name))
      (princ (strcat "\nEffectiveName: " effname))
    )
    )
  (princ)
)

 

EffectiveName-Name.png

Edited by Nikon
  • Like 1
Nikon Proficient

Nikon

Posted
  • Author
Posted (edited)
14 hours ago, BIGAL said:

If you select a block you can get two things its effective name and the name of the block, as mentioned often a block name becomes *U23 but it has an effective name still. So the way around it is to over select using SSget with "INSERT" and check the blocks "Effective name" matches the first block picked.

Using dumpit on a dynamic block 2 properties

; EffectiveName (RO) = "TA-WINDOW"
; Name = "*U308"

Thanks to GLAVCVS and BIGAL 

;; https://www.cadtutor.net/forum/topic/97779-specify-the-height-mark-at-the-base-point-of-the-blocks/
;; Thanks to GLAVCVS and BIGAL  10.05.2025
;; 1. Select the base block — "0.000".
;; 2. Select all the blocks (along with the base block). 
;; The code will process only those with the same effective name as the base effective name.
;; The marks will appear 600 mm above the insertion of each block.
;; The code works with static and dynamic blocks.

(defun c:MarkElev-EffNm (/ doc dmzAnt baseSS baseEnt baseObj baseEffName basePt allSS n ent entObj effName pt cota etq #etq)
  (vl-load-com)
  (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
  (setq dmzAnt (getvar "DIMZIN"))
  (setvar "DIMZIN" 0)
  (princ "\nSelect the base block (INSERT): ")
  (if (setq baseSS (ssget "_+.:E:S" '((0 . "INSERT"))))
    (progn
      (setq baseEnt (ssname baseSS 0))
      (setq baseObj (vlax-ename->vla-object baseEnt))
      (setq baseEffName (vla-get-EffectiveName baseObj))
      (setq basePt (cdr (assoc 10 (entget baseEnt))))
      (princ (strcat "\nEffectiveName the base block: " baseEffName))
      (princ "\nSelect all the blocks to mark: ")
      (if (setq allSS (ssget '((0 . "INSERT"))))
        (progn
          (setq n 0)
          (while (< n (sslength allSS))
            (setq ent (ssname allSS n))
            (setq entObj (vlax-ename->vla-object ent))
            (setq effName (vla-get-EffectiveName entObj))
            (setq pt (cdr (assoc 10 (entget ent))))
            (if (= effName baseEffName)
              (progn
                (if (equal pt basePt 1e-6)
                 
                  (entmakex
                    (list
                      (cons 0 "TEXT")
                      (cons 10 (list (car pt) (+ (cadr pt) 600)))
                      (cons 40 250)
                      (cons 1 "0.000")
                      (cons 50 0.0)
                      (cons 7 (getvar "TEXTSTYLE"))
                      (cons 8 (getvar "CLAYER"))
                    )
                  )
                
                  (progn
                    (setq cota pt)
                    (setq #etq (/ (- (cadr cota) (cadr basePt)) 1000.0))
                    (setq etq (if (minusp #etq)
                                (rtos #etq 2 3)
                                (strcat "+" (rtos #etq 2 3))
                              )
                    )
                    (entmakex
                      (list
                        (cons 0 "TEXT")
                        (cons 10 (list (car cota) (+ (cadr cota) 600)))
                        (cons 40 250)
                        (cons 1 etq)
                        (cons 50 0.0)
                        (cons 7 (getvar "TEXTSTYLE"))
                        (cons 8 (getvar "CLAYER"))
                      )
                    )
                  )
                )
              )
            )
            (setq n (1+ n))
          )
        )
      )
    )
  )
  (setvar "DIMZIN" dmzAnt)
  (princ)
)

 

Edited by Nikon
  • Like 1
GLAVCVS Proficient

GLAVCVS

Posted
Posted
16 minutes ago, Nikon said:

Thanks to GLAVCVS and BIGAL 

;; https://www.cadtutor.net/forum/topic/97779-specify-the-height-mark-at-the-base-point-of-the-blocks/
;; Thanks to GLAVCVS and BIGAL  10.05.2025
;; 1. Select the base block — "0.000".
;; 2. Select all the blocks (along with the base block). 
;; The code will process only those with the same effective name as the base effective name.
;; The marks will appear 600 mm above the insertion of each block.
;; The code works with static and dynamic blocks.

(defun c:MarkElev-EffNm (/ doc dmzAnt baseSS baseEnt baseObj baseEffName basePt allSS n ent entObj effName pt cota etq #etq)
  (vl-load-com)
  (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
  (setq dmzAnt (getvar "DIMZIN"))
  (setvar "DIMZIN" 0)
  (princ "\nSelect the base block (INSERT): ")
  (if (setq baseSS (ssget "_+.:E:S" '((0 . "INSERT"))))
    (progn
      (setq baseEnt (ssname baseSS 0))
      (setq baseObj (vlax-ename->vla-object baseEnt))
      (setq baseEffName (vla-get-EffectiveName baseObj))
      (setq basePt (cdr (assoc 10 (entget baseEnt))))
      (princ (strcat "\nEffectiveName the base block: " baseEffName))
      (princ "\nSelect all the blocks to mark: ")
      (if (setq allSS (ssget '((0 . "INSERT"))))
        (progn
          (setq n 0)
          (while (< n (sslength allSS))
            (setq ent (ssname allSS n))
            (setq entObj (vlax-ename->vla-object ent))
            (setq effName (vla-get-EffectiveName entObj))
            (setq pt (cdr (assoc 10 (entget ent))))
            (if (= effName baseEffName)
              (progn
                (if (equal pt basePt 1e-6)
                 
                  (entmakex
                    (list
                      (cons 0 "TEXT")
                      (cons 10 (list (car pt) (+ (cadr pt) 600)))
                      (cons 40 250)
                      (cons 1 "0.000")
                      (cons 50 0.0)
                      (cons 7 (getvar "TEXTSTYLE"))
                      (cons 8 (getvar "CLAYER"))
                    )
                  )
                
                  (progn
                    (setq cota pt)
                    (setq #etq (/ (- (cadr cota) (cadr basePt)) 1000.0))
                    (setq etq (if (minusp #etq)
                                (rtos #etq 2 3)
                                (strcat "+" (rtos #etq 2 3))
                              )
                    )
                    (entmakex
                      (list
                        (cons 0 "TEXT")
                        (cons 10 (list (car cota) (+ (cadr cota) 600)))
                        (cons 40 250)
                        (cons 1 etq)
                        (cons 50 0.0)
                        (cons 7 (getvar "TEXTSTYLE"))
                        (cons 8 (getvar "CLAYER"))
                      )
                    )
                  )
                )
              )
            )
            (setq n (1+ n))
          )
        )
      )
    )
  )
  (setvar "DIMZIN" dmzAnt)
  (princ)
)

 

👏👏

  • Thanks 1

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
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
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
Go to topic listing
×
×
  • Create New...