unwanted block

unwanted block

Mesut_Akcan
Collaborator Collaborator
833 Views
9 Replies
Message 1 of 10

unwanted block

Mesut_Akcan
Collaborator
Collaborator

I found the following codes from the internet. The codes work but there is a problem. When I end the programme with ESC key, a block is formed from the last letter. However, there is no code related to the block in the codes.

What can be done to solve this problem?

 

(defun c:num (/ oldPref oldSuf oldStart curStr newNum 
                actDoc actSp oldEcho oldSize *error*) 
  (defun *error* (msg) 
    (setvar "CMDECHO" oldEcho) 
    (princ) 
    ); end *error* 
  (vl-load-com) 
  (if(not num:Size)(setq num:Size(getvar "DIMTXT"))) 
  (if(not num:Pref)(setq num:Pref "")) 
  (if(not num:Suf)(setq num:Suf "")) 
  (if(not num:Num)(setq num:Num 1)) 
  (setq oldPref num:Pref 
        oldSuf num:Suf 
        oldStart num:Num 
        oldSize num:Size 
        actDoc(vla-get-ActiveDocument 
                (vlax-get-acad-object)) 
        oldEcho(getvar "CMDECHO") 
   ); end setq 
  (setvar "CMDECHO" 0) 
  (if(=(vla-get-ActiveSpace actDoc)1) 
         (setq actSp(vla-get-ModelSpace actDoc)) 
         (setq actSp(vla-get-PaperSpace actDoc)) 
    ); end if
  (setq num:Size 
    (getreal 
      (strcat "\nText size <"(rtos num:Size)">: "))) 
  (if(null num:Size)(setq num:Size oldSize)) 
  (setq num:Pref 
    (getstring T 
      (strcat "\nPrefix: <"num:Pref">: "))) 
  (if(= "" num:Pref)(setq num:Pref oldPref)) 
  (if(= " " num:Pref)(setq num:Pref "")) 
  (setq num:Suf 
    (getstring T 
      (strcat "\nSuffix: <"num:Suf">: "))) 
  (if(= "" num:Suf)(setq num:Suf oldSuf)) 
  (if(= " " num:Suf)(setq num:Suf "")) 
  (setq num:Num 
    (getint 
      (strcat "\nStarting number <"(itoa num:Num)">: "))) 
  (if(null num:Num)(setq num:Num oldStart))
  (princ "\n<<< Insert numbers or press Esc to quit >>> ")
      (while T 
        (setq curStr(strcat num:Pref(itoa num:Num)num:Suf) 
              newNum(vla-AddText actSp 
              curStr (vlax-3d-point '(0.0 0.0 0.0)) num:Size)) 
        (vla-put-Alignment newNum acAlignmentMiddleCenter) 
        (command "_.copybase"(trans '(0.0 0.0 0.0)0 1)(entlast)"") 
        (command "_.erase" (entlast) "") 
        (command "_.pasteclip" pause) 
        (setq num:Num(1+ num:Num)) 
       ); end while 
  (princ) 
 ); end of c:num
(princ "\n*** Dynamic numbering tool. Type NUM to run.*** ")

 

Mesut Akcan - Emekli Teknik Öğretmen
Blog Sayfam -- Youtube Kanalım -- LinkedIn
0 Likes
Accepted solutions (2)
834 Views
9 Replies
Replies (9)
Message 2 of 10

ВeekeeCZ
Consultant
Consultant

And you think that block came out of the blue? 

That's how the clipboard works in AutoCAD. Select some object/s, use COPYBASE to copy, then launch PASTECLIP... but cancel the pasting by ESC. 

You can report this to Autodesk, that you don't like it.

Message 3 of 10

Kent1Cooper
Consultant
Consultant

@ВeekeeCZ wrote:

.... That's how the clipboard works in AutoCAD. Select some object/s, use COPYBASE to copy, then launch PASTECLIP... ....


Well, that was a surprise to me.  I thought it would do that only with PASTEBLOCK, but sure enough, even PASTECLIP apparently works with a temporary Block to bring the stuff in, and then must Explode that and Purge its definition.  Those last steps are not happening if you ESCape out of placing it.  It may be possible to correct for that somehow....

 

EDIT:  Using MOVE instead of COPYBASE/ERASE/PASTECLIP leaves no extraneous Block definition, but it does leave the unwanted Text object at 0,0.

Kent Cooper, AIA
0 Likes
Message 4 of 10

Kent1Cooper
Consultant
Consultant

@Kent1Cooper wrote:
....Using MOVE instead of COPYBASE/ERASE/PASTECLIP leaves no extraneous Block definition, but it does leave the unwanted Text object at 0,0.

Try this.  It uses the fact that ESCape triggers the *error* handler, so it puts the deletion of the last object into that, but only if the routine got so far as to start making Text objects for placement, so it doesn't delete something you don't want deleted if you cancel sooner than that.  See meaningful changes at lines 4, 44 & 51, and the addition of 'running' into the localized variables list. 

(defun c:num (/ oldPref oldSuf oldStart curStr newNum 
                actDoc actSp oldEcho oldSize *error* running) 
  (defun *error* (msg)
    (if running (entdel (entlast))); got as far as making Texts? delete last one
    (setvar "CMDECHO" oldEcho)
    (princ)
    ); end *error*
  (vl-load-com)
  (if (not num:Size) (setq num:Size (getvar "DIMTXT")))
  (if (not num:Pref) (setq num:Pref ""))
  (if (not num:Suf) (setq num:Suf ""))
  (if (not num:Num) (setq num:Num 1))
  (setq oldPref num:Pref
        oldSuf num:Suf
        oldStart num:Num
        oldSize num:Size
        actDoc (vla-get-ActiveDocument (vlax-get-acad-object))
        oldEcho (getvar "CMDECHO")
   ); end setq
  (setvar "CMDECHO" 0)
  (if (= (vla-get-ActiveSpace actDoc) 1)
         (setq actSp (vla-get-ModelSpace actDoc))
         (setq actSp (vla-get-PaperSpace actDoc))
    ); end if
  (setq num:Size
    (getreal
      (strcat "\nText size <" (rtos num:Size) ">: ")))
  (if (null num:Size) (setq num:Size oldSize))
  (setq num:Pref
    (getstring T
      (strcat "\nPrefix: <" num:Pref ">: ")))
  (if (= "" num:Pref) (setq num:Pref oldPref))
  (if (= " " num:Pref) (setq num:Pref ""))
  (setq num:Suf
    (getstring T
      (strcat "\nSuffix: <"num:Suf">: ")))
  (if (= "" num:Suf) (setq num:Suf oldSuf))
  (if (= " " num:Suf) (setq num:Suf ""))
  (setq num:Num
    (getint
      (strcat "\nStarting number <" (itoa num:Num) ">: ")))
  (if (null num:Num) (setq num:Num oldStart))
  (princ "\n<<< Insert numbers or press Esc to quit >>> ")
  (setq running T); so last one will be eliminated by *error*
  (while T
    (setq
      curStr (strcat num:Pref (itoa num:Num) num:Suf)
      newNum (vla-AddText actSp curStr (vlax-3d-point '(0.0 0.0 0.0)) num:Size)
    )
    (vla-put-Alignment newNum acAlignmentMiddleCenter)
    (command "_.move" (entlast) "" (trans '(0.0 0.0 0.0) 0 1) pause)
    (setq num:Num (1+ num:Num))
  ); end while
)

 

Kent Cooper, AIA
0 Likes
Message 5 of 10

Sea-Haven
Mentor
Mentor

I would look at (while T maybe a more usable option like "press any key to exit Enter to continue". So setting a variable that exits the while cleanly rather than the crash out using ESC. Pretty easy to press Enter Enter  Enter  Enter 

0 Likes
Message 6 of 10

Mesut_Akcan
Collaborator
Collaborator

The latest codes have a major problem. When right-clicking with the mouse or pressing Enter on the keyboard, the text at position 0.0 remains.

Mesut Akcan - Emekli Teknik Öğretmen
Blog Sayfam -- Youtube Kanalım -- LinkedIn
0 Likes
Message 7 of 10

Mesut_Akcan
Collaborator
Collaborator
Accepted solution

I edited the codes as below and it is better now.

(defun c:num (/ oldPref oldSuf oldStart curStr newNum 
                oldSize *error*)
 
  (defun *error* (msg) 
	(if (not (wcmatch msg "*Function cancelled*,*bad argument type*"))(princ (strcat "\nError: " msg)))
	(if rx (entdel (entlast)))
    (princ) 
    ); end *error* 
  
  (vl-load-com) 
  (if(not num:Size)(setq num:Size(getvar "DIMTXT"))) 
  (if(not num:Pref)(setq num:Pref "")) 
  (if(not num:Suf)(setq num:Suf "")) 
  (if(not num:Num)(setq num:Num 1)) 
  (setq oldPref num:Pref 
        oldSuf num:Suf 
        oldStart num:Num 
        oldSize num:Size 
   ); end setq 
  
  (setq num:Size (getreal (strcat "\nText size <"(rtos num:Size)">: ")))
  (if(null num:Size)(setq num:Size oldSize)) 
  (setq num:Pref (getstring T (strcat "\nPrefix: <"num:Pref">: ")))
  (if(= "" num:Pref)(setq num:Pref oldPref)) 
  (if(= " " num:Pref)(setq num:Pref "")) 
  (setq num:Suf (getstring T (strcat "\nSuffix: <"num:Suf">: ")))
  (if(= "" num:Suf)(setq num:Suf oldSuf)) 
  (if(= " " num:Suf)(setq num:Suf "")) 
  (setq num:Num (getint (strcat "\nStarting number <"(itoa num:Num)">: "))) 
  (if(null num:Num)(setq num:Num oldStart))
  (princ "\n<<< Insert numbers or press Esc to quit >>> ")
      (while T 
        (setq curStr (strcat num:Pref(itoa num:Num)num:Suf))
	;----------------------------
 	(setq	rx '(0 0 0)
	 	tz (vlax-ename->vla-object
			(entmakex
			(list
				'(0 . "TEXT")
				(cons 1 curStr)
				;'(8 . "0") ;Layer
				(cons 10 rx)
				(cons 11 rx)
				(cons 40 num:Size)
				'(71 . 0)'(72 . 1)'(73 . 2)
			))
		)
	) 
	(while (/= 3 (car (setq n0 (grread T 1 0))))
		(setq n0 (cadr n0))
		(vla-TransformBy
			tz (vlax-tmatrix
			(list (list 1 0 0 (- (car n0) (car rx)))
				(list 0 1 0 (- (cadr n0) (cadr rx)))
				'(0 0 1 0)'(0 0 0 1)
			))
		)
		(setq rx n0)
	)
       (setq num:Num(1+ num:Num))
       ;----------------------------
       ); end while 
  (princ) 
 ); end of c:num
(princ "\n*** Dynamic numbering tool. Type NUM to run.*** ")

 

Mesut Akcan - Emekli Teknik Öğretmen
Blog Sayfam -- Youtube Kanalım -- LinkedIn
0 Likes
Message 8 of 10

ВeekeeCZ
Consultant
Consultant
Accepted solution

Try this one if you prefer to keep the original approach and purge the unwanted block.

0 Likes
Message 9 of 10

Kent1Cooper
Consultant
Consultant

@Mesut_Akcan wrote:

The latest codes have a major problem. When right-clicking with the mouse or pressing Enter on the keyboard, the text at position 0.0 remains.


But it works [for me] if you follow the instructions in the prompt to use ESCape to end it.  If you want those other ways to do it, you should also change the prompt.

Kent Cooper, AIA
0 Likes
Message 10 of 10

Sea-Haven
Mentor
Mentor

Here is another with some options like A B C etc. Circle or square around text.

 

SeaHaven_0-1705633272296.png

 

SeaHaven_1-1705633289902.png

Should change to a single dcl also add no outside shape.

0 Likes