Topic: Text disappearing

[hmspe]

I'm probably missing something simple.  This routine adds a circuit number to a home run in electrical drawings.  It works fine in general, but the inserted text sometimes disappears if I run the "wrong" command as the next command (seems to happen if the TEXT command is next) or if I right click to re-run C:IS then press ESC.  Does anyone see any flaws in the logic or know a way to fix the text so it doesn't disappear?  Thanks for any thoughts or suggestions. 

Martin

Code: [Select]

(defun eehr_id ( / *error* 72code 73code ds end_pt entity entity_ename
                   memb pt2 quarter_pi rot rot2 ss start_pt tempX)

  (defun dxf (1code 1ent) (cdr (assoc 1code 1ent)))

  (defun *error* (msg)
    (if (member msg '( "console break" "Function cancelled" "quit / exit abort"))
      (progn
        (setq new (entlast))
        (entdel new)
      )
      (progn
        (if msg
          (princ (strcat "\nError: " msg))
        )
      )
    )
    (princ)
  ) ;end error

  (defun get_string (pt2 c72 c73 / a b c elist newent)

    (defun GetKey ( / result )
      (while                                         ; repeat until a key is pressed
        (null (eq 2 (car (setq result (grread)))))   ; 2 as the first element of the
                                                     ;   list returned says the input
                                                     ;   was keyboard.  Null returns
                                                     ;   T if the argument equated to
                                                     ;   nil, nil otherwise, so keyboard
                                                     ;   input will exit the loop
      )
      (chr (cadr result))                            ; convert the code returned to
                                                     ;   a character
    )

    (setq a "_")
    (setq b "")
    (setq elist                                  ; set up a text entity
      (list
        '(0 . "TEXT")
        (cons 8 "POWER")
        (cons 7 (getvar "textstyle"))
        (cons 40 (getvar "textsize"))
        (cons 62 2)                              ; set color = yellow
        (cons 50 0.0)                            ; rotation
        (cons 10 pt2)                            ; dummy value
        (cons 11 pt2)                            ; insert point
        (cons 72 c72)                            ; vertical justification
        (cons 73 c73)                            ; horizontal justification
        (cons 1 a)
      )
    )
    (entmake elist)                              ; make the entity
    (setq newent (entlast))
    (setq newent (entget newent))
    (while (/= b "\r")                           ; "\r" is enter
      (setq b "")                                ; initialize
      (while (= b "")                            ; loop
        (setq b (getkey))                        ; wait for a keystroke
        (if (not (wcmatch b "[a-z],[A-Z],[0-9],-,['#],[' ],[`,],\r,\010"))
                                                 ; test for letters, numbers, dash, pound, space, comma.
                                                 ;   ESC, and backspace
          (setq b "")                            ; reset if not a valid character
        )
      )   
      (if (/= b "\r")                            ; if not enter
        (progn
          (if (= b "\010")                       ; test for backspace
            (progn                               ; its a backspace
              (if (> (strlen a) 0)               ; can't delete from zero length string
                (setq a (substr a 1 (1- (strlen a))))
              )
            )
            (progn
              (if (= a "_")
                (setq a "")
              ) 
              (setq a (strcat a b))
            )
          )
        ) 
      )
      (setq newent (subst (cons 1 a) (assoc 1 newent) newent))
                                                 ; set up to change the text in the database
      (entmod newent)                            ; update the database
    )
    (setq newent (subst (cons 62 256) (assoc 62 newent) newent))
                                                 ; set up to change the text color in the database
    (entmod newent)                              ; update the database
    a
  ) 

  (setvar "cmdecho" 0)
  (command "._undo" "be")
  (setq ds (getvar "dimscale"))                      ; get the current scale
  (setq ss "")
  (while (= ss "")
    (setq ss (car (entsel "\nSelect homerun to annotate...  ")))
    (setq entity (entget ss))
    (if (not (and (= (dxf 0 entity) "INSERT")        ; is it a block?
                  (= (substr (dxf 2 entity) 1 2) "EE") ; modern homeruns start with "EE" or "EEHR"
             )
        )
      (setq ss "")
    )
  ) 
  (setq entity_ename (dxf -1 entity))
  (setq entity (entget entity_ename))
  (setq tempX (vlax-ename->vla-object entity_ename)) 
                                                     ; cast to an activeX entity
  (foreach memb (vlax-invoke tempX 'Explode)
                                                     ; explode the activeX block, then
                                                     ; process each component
    (if (= (vla-get-objectname memb) "AcDbPolyline")
                                                     ; the arrowhead is a LWPOLYLINE
      (progn
        (setq new_entity memb)                       ; store the arrowhead
        (setq start_pt (vlax-curve-getStartPoint new_entity))
        (setq end_pt (vlax-curve-getEndPoint new_entity))
        (vla-Delete memb)
        (setq rot (+ (angle start_pt end_pt) 3.7051727))
        (setq pt2 (polar start_pt rot (* ds 0.19483940)))
                                                     ; set a point inside the homerun
        (setq rot2 (- (angle end_pt start_pt) 0.365235))
        (setq quarter_pi (/ pi 4.0))
        (while (< rot2 0.0)
          (setq rot2 (+ rot2 (* pi 2.0)))
        ) 
        (while (> rot2 (* pi 2.0))
          (setq rot2 (- rot2 (* pi 2.0)))
        ) 
        (cond
          ((or (< rot2 quarter_pi)                       ; ML
               (>= rot2 (* quarter_pi 7))
           )
            (progn
               (setq 72code 0)
               (setq 73code 2)
               (setq pt2 (polar pt2 0.0 (* ds 0.19483940)))
            )
          )
          ((and (>= rot2 quarter_pi)                     ; C
                (< rot2 (* quarter_pi 3))
           )
            (progn
              (setq 72code 1)
              (setq 73code 0)
              (setq pt2 (polar pt2 (/ pi 2.0) (* ds 0.19483940)))
            )
          )
          ((and (>= rot2 (* quarter_pi 3))               ; MR
                (< rot2 (* quarter_pi 5))
           )
            (progn
              (setq 72code 2)
              (setq 73code 2)
              (setq pt2 (polar pt2 pi (* ds 0.19483940)))
            )
          )
          ((and (>= rot2 (* quarter_pi 5))               ; TC
                (< rot2 (* quarter_pi 7))
           )
            (progn
              (setq 72code 1)
              (setq 73code 3)
              (setq pt2 (polar pt2 (* (/ pi 2.0) 3.0) (* ds 0.19483940)))
            )
          )
        )
        (prompt "\nCircuit number...  ")
        (setq data (get_string pt2 72code 73code))
      )
      (vla-Delete memb)
   )
  )
  (*error* nil)
  (command "._undo" "e")
  (princ)
)


[CAB]

Martin,
Would you post a text DWG to run the lisp with?

There are several things i would do differently but I don't see anything yet that would cause the text to be erased.

How about a brief explanation as to what the lisp is to accomplish.

Is the HomeRun a block & you explode it to get at the polyline?

[hmspe]

CAB,

Thanks for the reply.  The attached HR.DWG has four receptacle/homerun combinations.  The top two show what the result of running C:IS should be (except I've changed the font to ROMANS -- my default font is a custom font that I don't distribute for security reasons).  The homerun is the curve with the arrowhead.  I've also attached the base homerun file.  Each homerun in HR.DWG is a custom part -- my homerun insertion routine inserts the base homerun block based on a CEN osnap to, in this case, the center of a receptacle symbol.  The insertion routine allows rotation of the symbol, then creates a custom replacement homerun that's trimmed to the circle or arc that was the subject of the insertion CEN osnap. 

All the hand waving starting at

Code: [Select]

(setq entity_ename (dxf -1 entity)) is to determine the rotation of the homerun symbol, then select a position and justification for the text, and it works with no problems.  Note that I'm working with legacy symbols, so this is a lot more complicated than it would have been had I been starting from scratch.  All my drawings

When I was putting the drawing together I ran C:IS on the upper right homerun, then pressed ESC a couple of times.  The text for that entry disappeared.

Martin

[Jeff_M]

Martin,
Your Error function is to blame.....if you start the command, then ESC out it calls the Error function, in that it has this code:

Code: [Select]

(if (member msg '( "console break" "Function cancelled" "quit / exit abort"))
      (progn
        (setq new (entlast))
        (entdel new)
      )
which is deleting the last entity in the drawing. It doesn't know that you only want to delete any object created only with the current function, so it deletes the last entity in the drawing, period.

No time to figure the solution, as that really depends on what you want.

[CAB]

Good catch Jeff, i missed it.

[hmspe]

Jeff,

Thanks.  That makes sense.  Now to figure out if that part of the error function was supposed to do something or if I just did a cut and paste and picked the wrong sample.

CAB,

As always, thanks for looking at this.


Martin

[CAB]

An error may leave the preliminary text object in the drawing.
What I would do is set the text object ename to a variable and then in the error handler delete it if there
is an error message. The way you have it now it removes it if there is an error message.

I should have some time tomorrow afternoon if you don't get to a solution.

[CAB]

Give this a test.

Code: [Select]

;; =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
;;  Revisions  [CAB 09.11.08]
;;  replaced error function
;;  new variable 'newelst'
;;  revised the Text entmake
;;  added princ of Circuit number to command line
;; =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
(defun eehr_id ( / *error* 72code 73code ds end_pt entity entity_ename
                   memb pt2 quarter_pi rot rot2 ss start_pt tempX)

  (defun dxf (1code 1ent) (cdr (assoc 1code 1ent)))

  ;;  CAB replaced error function [CAB 09.11.08]
  (defun *error* (msg)
    (if (not
          (member msg  '("console break" "Function cancelled" "quit / exit abort" "" nil)))
       (princ (strcat "\nError: " msg))
    ) ; if
    ;; if newelst exist then delete it
    (and newent (entdel newent)) ;  [CAB 09.11.08]
    (princ)
  ) ; end error function

  (defun get_string (pt2 c72 c73 / a b c elist newent newelst)

    (defun GetKey ( / result )
      (while                                         ; repeat until a key is pressed
        (null (eq 2 (car (setq result (grread)))))   ; 2 as the first element of the
                                                     ;   list returned says the input
                                                     ;   was keyboard.  Null returns
                                                     ;   T if the argument equated to
                                                     ;   nil, nil otherwise, so keyboard
                                                     ;   input will exit the loop
      )
      (chr (cadr result))                            ; convert the code returned to
                                                     ;   a character
    )

    (setq a "_")
    (setq b "")
    (setq elist                                  ; set up a text entity
      (list
        '(0 . "TEXT")
        (cons 8 "POWER")
        (cons 7 (getvar "textstyle"))
        (cons 40 (getvar "textsize"))
        (cons 62 2)                              ; set color = yellow
        (cons 50 0.0)                            ; rotation
        (cons 10 pt2)                            ; dummy value
        (cons 11 pt2)                            ; insert point
        (cons 72 c72)                            ; vertical justification
        (cons 73 c73)                            ; horizontal justification
        (cons 1 a)
      )
    )
                                 
    (setq newent (entmakex elist)) ; make the entity  [CAB 09.11.08]
    (setq newelst (entget newent)) ; new variable [CAB 09.11.08]
    (while (/= b "\r")                           ; "\r" is enter
      (setq b "")                                ; initialize
      (while (= b "")                            ; loop
        (setq b (getkey))                        ; wait for a keystroke
        (if (not (wcmatch b "[a-z],[A-Z],[0-9],-,['#],[' ],[`,],\r,\010"))
                                                 ; test for letters, numbers, dash, pound, space, comma.
                                                 ;   ESC, and backspace
          (setq b "")                            ; reset if not a valid character
        )
      )   
      (if (/= b "\r")                            ; if not enter
        (progn
          (if (= b "\010")                       ; test for backspace
            (progn                               ; its a backspace
              (if (> (strlen a) 0)               ; can't delete from zero length string
                (setq a (substr a 1 (1- (strlen a))))
              )
            )
            (progn
              (if (= a "_")
                (setq a "")
              ) 
              (setq a (strcat a b))
            )
          )
        ) 
      )
      (setq newelst (subst (cons 1 a) (assoc 1 newelst) newelst)) ;  [CAB 09.11.08]
                                                 ; set up to change the text in the database
      (entmod newelst)                            ; update the database  [CAB 09.11.08]
    )
    (setq newelst (subst (cons 62 256) (assoc 62 newelst) newelst))
                                                 ; set up to change the text color in the database  [CAB 09.11.08]
    (entmod newelst)                              ; update the database  [CAB 09.11.08]
    a
  ) 

  (setvar "cmdecho" 0)
  (command "._undo" "be")
  (setq ds (getvar "dimscale"))                      ; get the current scale
  (setq ss "")
  (while (= ss "")
    (setq ss (car (entsel "\nSelect homerun to annotate...  ")))
    (setq entity (entget ss))
    (if (not (and (= (dxf 0 entity) "INSERT")        ; is it a block?
                  (= (substr (dxf 2 entity) 1 2) "EE") ; modern homeruns start with "EE" or "EEHR"
             )
        )
      (setq ss "")
    )
  ) 
  (setq entity_ename (dxf -1 entity))
  (setq entity (entget entity_ename))
  (setq tempX (vlax-ename->vla-object entity_ename)) 
                                                     ; cast to an activeX entity
  (foreach memb (vlax-invoke tempX 'Explode)
                                                     ; explode the activeX block, then
                                                     ; process each component
    (if (= (vla-get-objectname memb) "AcDbPolyline")
                                                     ; the arrowhead is a LWPOLYLINE
      (progn
        (setq new_entity memb)                       ; store the arrowhead
        (setq start_pt (vlax-curve-getStartPoint new_entity))
        (setq end_pt (vlax-curve-getEndPoint new_entity))
        (vla-Delete memb)
        (setq rot (+ (angle start_pt end_pt) 3.7051727))
        (setq pt2 (polar start_pt rot (* ds 0.19483940)))
                                                     ; set a point inside the homerun
        (setq rot2 (- (angle end_pt start_pt) 0.365235))
        (setq quarter_pi (/ pi 4.0))
        (while (< rot2 0.0)
          (setq rot2 (+ rot2 (* pi 2.0)))
        ) 
        (while (> rot2 (* pi 2.0))
          (setq rot2 (- rot2 (* pi 2.0)))
        ) 
        (cond
          ((or (< rot2 quarter_pi)                       ; ML
               (>= rot2 (* quarter_pi 7))
           )
            (progn
               (setq 72code 0)
               (setq 73code 2)
               (setq pt2 (polar pt2 0.0 (* ds 0.19483940)))
            )
          )
          ((and (>= rot2 quarter_pi)                     ; C
                (< rot2 (* quarter_pi 3))
           )
            (progn
              (setq 72code 1)
              (setq 73code 0)
              (setq pt2 (polar pt2 (/ pi 2.0) (* ds 0.19483940)))
            )
          )
          ((and (>= rot2 (* quarter_pi 3))               ; MR
                (< rot2 (* quarter_pi 5))
           )
            (progn
              (setq 72code 2)
              (setq 73code 2)
              (setq pt2 (polar pt2 pi (* ds 0.19483940)))
            )
          )
          ((and (>= rot2 (* quarter_pi 5))               ; TC
                (< rot2 (* quarter_pi 7))
           )
            (progn
              (setq 72code 1)
              (setq 73code 3)
              (setq pt2 (polar pt2 (* (/ pi 2.0) 3.0) (* ds 0.19483940)))
            )
          )
        )
        (prompt "\nCircuit number...  ")
        (princ (setq data (get_string pt2 72code 73code)))
      )
      (vla-Delete memb)
   )
  )
  (*error* nil)
  (command "._undo" "e")
  (princ)
)

[hmspe]

CAB,

That works perfectly.  Thanks.

Martin

[CAB]

Martin,
Made some more modifications.
There is a case where some of the exploded block can be left in the drawing.

Code: [Select]

;; =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
;;  Revisions  [CAB 09.12.08]
;;  replaced error function
;;  revised the Text entmake & new grread routine
;;  added princ of Circuit number to command line
;; =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
(defun eehr_id (/ *error* 72code 73code ds end_pt entity entity_ename memb pt2 quarter_pi
                rot rot2 start_pt tempX usrcmd get_string new_entity ent
               )

  (defun dxf (1code 1ent) (cdr (assoc 1code 1ent)))

  ;;-------------------------------------------------
  ;;  CAB replaced error function [CAB 09.11.08]
  (defun *error* (msg)
    (if (not
          (member msg '("console break" "Function cancelled" "quit / exit abort" "" nil))
        )
      (princ (strcat "\nError: " msg))
    )
    ;; if TextEnt exist then delete it.
    (and TextEnt (entdel TextEnt)) ;  [CAB 09.11.08]
    (and usrcmd (setvar "cmdecho" 0))
    (princ)
  )       ; end error function

  ;;-------------------------------------------------------------
  ;;  create a text object, then allow user to edit it via grread
  ;;  return the text string, keep the text object unless ESCAPE
  (defun get_string (pt2 c72 c73 / str elist TextEnt key grr)
    (setq str "_") ; default start character, visual referance on the screen
    (setq elist ; set up a text entity
           (list
             '(0 . "TEXT")
             (cons 8 "POWER")
             (cons 7 (getvar "textstyle"))
             (cons 40 (getvar "textsize"))
             (cons 62 2)   ; set color = yellow
             (cons 50 0.0) ; rotation
             (cons 10 pt2) ; dummy value
             (cons 11 pt2) ; insert point
             (cons 72 c72) ; vertical justification
             (cons 73 c73) ; horizontal justification
             (cons 1 str)
           )
    )
    ;; create a text object then edit it
    (setq TextEnt (entmakex elist)) ; make the entity  [CAB 09.11.08]
    (setq elist (entget TextEnt))   ; new variable [CAB 09.11.08]
    (prompt "\nCircuit number...  ")
    (while ; get the string from user, exit only for ENTER
      (cond
        ((eq 2 (car (setq grr (grread)))) ; keyboard input
         (setq key (cadr grr))
         (cond
           ((= key 8) ; backspace
            (if (/= str "")
              (progn
                (setq str (substr str 1 (1- (strlen str))))
                (prompt (strcat (chr 8) " " (chr 8)))
                (setq elist (subst (cons 1 str) (assoc 1 elist) elist))
                (entmod elist)
              )
              t ;stay in loop
            )
           )
           ((= key 13) ; ENTER- where done here
            nil ; exit loop
           )
           ;;  if a valid key press add to string
           ((wcmatch (chr key) "[a-z],[A-Z],[0-9],-,`#,` ,`,")
            (if (= str "_")
              (setq str (chr key))
              (setq str (strcat str (chr key)))
            )
            (prompt (chr key))
            ;;  update text
            (setq elist (subst (cons 1 str) (assoc 1 elist) elist))
            (entmod elist)
           )
           ((princ "\nInvalid Keypress.")
            (princ (strcat "\nCircuit number...  " str)))
         )
        )
        ((princ "\nKeyboard entry only."))
      )
    )     ; while
    ;; set up to change the text color in the database
    (setq elist (subst (cons 62 256) (assoc 62 elist) elist))
    (entmod elist) ; update the database
    str   ; return the string
  )

  ;;-------------------------------------------------
  ;;             S T A R T   H E R E                 
  ;;-------------------------------------------------
  (setq usrcmd (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (command "._undo" "be")
  (setq ds (getvar "dimscale")) ; get the current scale
  ;;  Loop, user must pick correct block or ESCAPE
  (while
    (if (setq ent (car (entsel "\nSelect homerun to annotate...  ")))
      (progn ; got a user pick
        (setq entity (entget ent))
        (if (not
              (and
                (= (dxf 0 entity) "INSERT") ; is it a block?
                (= (substr (dxf 2 entity) 1 2) "EE") ; modern homeruns start with "EE" or "EEHR"
              )
            )
          (princ "\nError - Not a Homerun, Try again.") ; stay in loop
          nil ; exit loop
        )
      )
      (princ "\nMissed, Try again.") ; stay in loop
    )
  )
  (setq entity_ename (dxf -1 entity))
  (setq entity (entget entity_ename))
  (setq tempX (vlax-ename->vla-object entity_ename)) ; cast to an activeX entity
  (foreach memb (vlax-invoke tempX 'Explode) ; explode the activeX block, then
          ; process each component
    (if (= (vla-get-objectname memb) "AcDbPolyline") ; the arrowhead is a LWPOLYLINE
      (progn
        (setq new_entity memb) ; store the arrowhead
        (setq start_pt (vlax-curve-getStartPoint new_entity))
        (setq end_pt (vlax-curve-getEndPoint new_entity))
        (vla-Delete memb)
        (setq rot (+ (angle start_pt end_pt) 3.7051727))
        (setq pt2 (polar start_pt rot (* ds 0.19483940)))
          ; set a point inside the homerun
        (setq rot2 (- (angle end_pt start_pt) 0.365235))
        (setq quarter_pi (/ pi 4.0))
        (while (< rot2 0.0) (setq rot2 (+ rot2 (* pi 2.0))))
        (while (> rot2 (* pi 2.0)) (setq rot2 (- rot2 (* pi 2.0))))
        (cond
          ((or (< rot2 quarter_pi) ; ML
               (>= rot2 (* quarter_pi 7))
           )
           (setq 72code 0)
           (setq 73code 2)
           (setq pt2 (polar pt2 0.0 (* ds 0.19483940)))
          )
          ((and (>= rot2 quarter_pi) ; C
                (< rot2 (* quarter_pi 3))
           )
           (setq 72code 1)
           (setq 73code 0)
           (setq pt2 (polar pt2 (/ pi 2.0) (* ds 0.19483940)))
          )
          ((and (>= rot2 (* quarter_pi 3)) ; MR
                (< rot2 (* quarter_pi 5))
           )
           (setq 72code 2)
           (setq 73code 2)
           (setq pt2 (polar pt2 pi (* ds 0.19483940)))
          )
          ((and (>= rot2 (* quarter_pi 5)) ; TC
                (< rot2 (* quarter_pi 7))
           )
           (setq 72code 1)
           (setq 73code 3)
           (setq pt2 (polar pt2 (* (/ pi 2.0) 3.0) (* ds 0.19483940)))
          )
        )
      )
      (vla-Delete memb)
    )
  )
 
  (setq data (get_string pt2 72code 73code))
  (*error* nil)
  (command "._undo" "e")
  (princ)
)

[hmspe]

Nicely done.  Thanks.