Strange error fo old lisp

[danglar]

This lisp written more than 20 years ago can break text string and place spitted part below of the rest part of string. On new AutoCAD version it returns strange error  after selecting text entity

It's complicated for me to find where the source of the problem

Can somebody help me?

Any help will be very appretiated

[chriscowgill7373]

Did something else get modified with the routine?  It is asking to change the case of the variable FN, but FN hasnt been Setq'd in the file yet.  Is there something else that needs to load first that defines FN as a global variable, or is this something that is supposed to be called from another program?

The issue is on Line49

The code that you have posted is not the original code:

http://cadtips.cadalyst.com/notestext/break-text

 The original file is on the left, your file is on the right:

[CADaSchtroumpf · Accepted solution]

Good remark of chriscowgill7373

If you want write the DCL file in temporary file, I suggest this method.

;Tip1380.LSP:  BT.LSP   Break text   (c)1997, Phil Clark

(defun
     C:BT (/ BRK CLAY IS_STH TXTSTR LEN tmp_file dcl_file DCL_ID TH
           ROT INSPT NEWTXT1 NEWTXT2 ENT IS_TXT RTD
           DTR SLID2NT INSPT2 ENT2
          )
  (defun
       SLID2NT (VALS)
    (setq NEWTXT1 (substr TXTSTR 1 (atoi VALS)))
    (setq NEWTXT2
           (substr TXTSTR (1+ (atoi VALS)) LEN)
    ) ; end of setq
    (set_tile "bt_nt1" NEWTXT1)
    (set_tile "bt_nt2" NEWTXT2)
  ) ;end defun SLID2NT 
    ;radians to degrees
  (defun RTD (A) (/ (* A 180.0) pi)) ;end RTD
    ;degrees to radians
  (defun DTR (A) (* pi (/ A 180.0))) ;end defun dtr
  (setvar "texteval" 1)
  (setvar "cmdecho" 0)
  (setq ENT NIL
        IS_STH NIL
        IS_TXT NIL
        INSPT NIL
        INSPT2 NIL
  ) ; end of setq
  (while (not ENT)
    (setq
      ENT (entsel "\nSelect text entity to break: ")
    ) ; end of setq
    (if ENT
      (progn
        (setq ENT (entget (car ENT)))
        (if (= "TEXT" (cdr (assoc 0 ENT)))
          (setq IS_TXT t)
          (setq ENT t)
        ) ;end if
      ) ;end progn
      (setq ENT t)
    ) ;end if
  ) ;end while
  (if IS_TXT
    (progn
      (setq TXTSTR (cdr (assoc 1 ENT)))
      (setq LEN (strlen TXTSTR))
			(setq
				tmp_file (vl-filename-mktemp "BT.dcl")
				dcl_file (open tmp_file "w")
			)
      (write-line "bt : dialog {" dcl_file)
      (write-line "  label = \"Text Break\";" dcl_file)
      (write-line "  : text {" dcl_file)
      (write-line "     key = \"bt_txt\";" dcl_file)
      (write-line
        (strcat "      width = " (itoa LEN) ";")
        dcl_file
      ) ; end of write-line
      (write-line "     alignment = centered;" dcl_file)
      (write-line "  }" dcl_file)
      (write-line "  : slider {" dcl_file)
      (write-line "     key = \"bt_sld\";" dcl_file)
      (write-line
        (strcat
          "          max_value = "
          (itoa LEN)
          ";"
        ) ; end of strcat
        dcl_file
      ) ; end of write-line
      (write-line
        (strcat "          value = " (itoa LEN) ";")
        dcl_file
      ) ; end of write-line
      (write-line "     }" dcl_file)
      (write-line "  : boxed_column {" dcl_file)
      (write-line "     : text {" dcl_file)
      (write-line "        key = \"bt_nt1\";" dcl_file)
      (write-line "     }" dcl_file)
      (write-line "     : text {" dcl_file)
      (write-line "        key = \"bt_nt2\";" dcl_file)
      (write-line "     }" dcl_file)
      (write-line "  }" dcl_file)
      (write-line "  ok_cancel;" dcl_file)
      (write-line "}" dcl_file)
      (close dcl_file)
      (setq DCL_ID (load_dialog tmp_file))
      (if (not (new_dialog "bt" DCL_ID))
        (exit)
      ) ; end of if
      (set_tile "bt_txt" TXTSTR)
      (SLID2NT (itoa LEN))
      (action_tile "bt_sld" "(SLID2NT $value)")
      (action_tile
        "accept"
        (strcat "(setq BRK T)" "(done_dialog)")
      ) ; end of action_tile
      (setq TH (cdr (assoc 40 ENT)))
      (setq ROT (RTD (cdr (assoc 50 ENT))))
      (setq INSPT (cdr (assoc 10 ENT)))
      (start_dialog)
      (unload_dialog DCL_ID)
      (princ)
      (if BRK
        (if (and (/= "" NEWTXT2)
                 (/= " " NEWTXT2)
                 (/= "" NEWTXT1)
            ) ; end of and
          (progn
            (princ)
            (princ)
            (setq ENT (subst
                        (cons 1 NEWTXT1)
                        (cons 1 TXTSTR)
                        ENT
                      ) ; end of subst
            ) ; end of setq
            (entmod ENT)
            (command "_.redraw")
            (setq INSPT2
                   (getpoint
                     "\n\nPick insertion point for 2nd text entity:
Press <CR> to place below 1st text: "
                   ) ; end of getpoint
            ) ; end of setq
            (if (not INSPT2)
              (setq INSPT2
                     (polar
                       INSPT
                       (DTR (- ROT 90.0))
                       (* 1.6666 TH)
                     ) ; end of polar
              ) ; end of setq
            ) ;end if
            (command
              "_.copy"
              (cdr (assoc -1 ENT))
              ""
              INSPT
              INSPT2
            ) ; end of command
            (setq ENT2 (entget (entlast)))
            (setq ENT2 (subst
                         (cons 1 NEWTXT2)
                         (cons 1 NEWTXT1)
                         ENT2
                       ) ; end of subst
            ) ; end of setq
            (entmod ENT2)
          ) ;end progn
        ) ;end if
      ) ;end if
    ) ;end progn
    (princ)
  ) ;end if
  (princ)
)   ;end defun  

[danglar]

First of all I want to thank to       CADaStroumph

for a god solution of this issue

Yes, I modified the original code in order to save dcl file in a temporal directory according to

roamablerootprefix system  variable but is was unsuccessful

Your solution is much  better!

Another question if it possible

I find in my storage stuff (I don't know who create it) another routine for the same goal (see attached lisp)

it working properly for my purposes but I want to add an option to place the "second part " of  text string as it possible in upgraded by your efforts routine...

something like this:

(setq INSPT2
                   (getpoint
                     "\n\nPick insertion point for 2nd text entity:
Press <CR> to place below 1st text: "
                   ) ; end of getpoint
            ) ; end of setq
            (if (not INSPT2)
              (setq INSPT2
                     (polar
                       INSPT
                       (DTR (- ROT 90.0))
                       (* 1.6666 TH)
                     ) ; end of polar
              ) ; end of setq
            ) ;end if

Is it possible?

Any help as I say will be very appreciated

[danglar]

I did some efforts to combine these routines but the final solution don't working properly

Where I did a mistake?

(defun c:tsb (/ acode actdoc idx ipt ll obj obj2 objlen objul ofs ofs2 pickdist
              pt rot sel str str2 textlen ur)

  ;; Breaks a text object selected at the character it is selected into two text objects, with them being
  ;;  in the same location as they were when they were one text object.
  ;;  Works with all justifications except Fit & Align


  (defun *error* (msg)
    (vla-endundomark ActDoc)
    (prompt (strcat "\n Error--> " msg))
  )
     ;---------------------------------------------------------------------
  (setq ActDoc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-endundomark ActDoc)
  (vla-startundomark ActDoc)
  (defun RTD (A) (/ (* A 180.0) pi)) ;end RTD
    ;degrees to radians
  (defun DTR (A) (* pi (/ A 180.0))) ;end defun dtr
  (setq TH (cdr (assoc 40 Obj)))
      
      ;(setq INSPT (cdr (assoc 10 Obj)))
  
  
  (if
    (and
      (setq Sel
             (entsel
               "\n Select text object to break (in the end of the character to break at): "
             )
      )
      (setq Obj (vlax-ename->vla-object (car Sel)))
      (= (vla-get-objectname Obj) "AcDbText")
      (setq Str (vla-get-textstring Obj))
      (setq Rot (vla-get-rotation Obj))
      (setq Pt (trans (cadr Sel) 1 0))
      (vl-position (vla-get-alignment Obj) '(0 1 2 4 6 7 8 9 10 11 12 13 14))
    )
     (progn
       (setq Ipt (safearray-value (vlax-variant-value(vla-get-insertionpoint obj))))
       (setq pickdist (distance Ipt pt))

       (vla-put-rotation obj 0.0)
       (setq Ipt (safearray-value (vlax-variant-value(vla-get-insertionpoint obj))))
       (setq obj2 (vlax-invoke Obj 'Copy))
       (vla-getboundingbox Obj 'll 'ur)
       (setq ll (safearray-value ll)
             ur (safearray-value ur)
             objul (list (car ll) (cadr ur))
             objlen (distance ur objul))

       (setq idx     (strlen str)
             str2    str
             textlen (1+ pickdist)
       )
       (while (> textlen pickdist)
         (setq str (substr str 1 (setq idx (1- idx))))
         (vla-put-textstring Obj str)
         (vla-getboundingbox Obj 'll 'ur)
         (setq ll (safearray-value ll)
               ur (safearray-value ur))
         (setq textlen (distance (list (car ll) (cadr ur)) ur))
       )
       (setq str2 (substr str2 (1+ (strlen str))))
       (vla-put-textstring obj2 str2)
       (vla-getboundingbox Obj2 'll 'ur)
       (setq ll (safearray-value ll)
             ur (safearray-value ur)
             ofs2 (- objlen (distance ll (list (car ur)(cadr ll)))))
       (setq Ipt1 (safearray-value (vlax-variant-value(vla-get-insertionpoint obj))))
      ; (setq Ipt2 (safearray-value (vlax-variant-value(vla-get-insertionpoint obj2))))
	   
	   
	   (setq Ipt2
                   (getpoint
                     "\n\nPick insertion point for 2nd text entity:
Press <CR> to place below 1st text: "
                   ) ; end of getpoint
            ) ; end of setq
            (if (not Ipt2)
              (setq Ipt2
                     (polar
                       Pt
                       (DTR (- Rot 90.0))
                       (* 1.6666 TH)
                     ) ; end of polar
              ) ; end of setq
            ) ;end if
            (command
              "_.copy"
              (cdr (assoc -1 Obj))
              ""
              Ipt1
              Ipt2
            ) ; end of command
       
       (vla-put-rotation obj rot)
       (vla-put-rotation obj2 rot)
       (setq acode (vla-get-alignment Obj))
       (cond
         ((vl-position aCode '(0 6 9 12)) ; Left
           (vla-move obj2 (vlax-3d-point objul)(vlax-3D-point (polar objul rot ofs2)))
          )
         ((vl-position aCode '(1 4 7 10 13)) ; Center
           (vla-move obj (vlax-3d-point objul)(vlax-3D-point (polar objul (+ rot pi) (distance ipt ipt1))))
           (vla-move obj2 (vlax-3d-point objul)(vlax-3D-point (polar objul rot (distance ipt ipt2))))
          )
         ((vl-position aCode '(2 8 11 14)) ;Right
           (vla-move obj (vlax-3d-point objul)(vlax-3D-point (polar objul (+ rot pi) (distance ipt ipt1))))
          )
         ) ; end cond stmt
      )
     (cond
       ((not Sel)
        (prompt "\n No object selected.")
       )
       ((not Str)
        (prompt "\n Object selected was not a plain text object.")
       )
       (t
        (prompt
          "\n Text object selected does not have an alignment that would work."
        )
       )
     )
  )
  (vla-endundomark ActDoc)
  (princ)
)

[CADaSchtroumpf · Accepted solution]

Perhaps this?

(defun c:tsb (/ acode actdoc idx ipt ll obj obj2 objlen objul ofs ofs2 pickdist
              pt rot sel str str2 textlen ur pt_move)

  ;; Breaks a text object selected at the character it is selected into two text objects, with them being
  ;;  in the same location as they were when they were one text object.
  ;;  Works with all justifications except Fit & Align


  (defun *error* (msg)
    (vla-endundomark ActDoc)
    (prompt (strcat "\n Error--> " msg))
  )
     ;---------------------------------------------------------------------
  (setq ActDoc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-endundomark ActDoc)
  (vla-startundomark ActDoc)
  (if
    (and
      (setq Sel
             (entsel
               "\n Select text object to break (in the end of the character to break at): "
             )
      )
      (setq Obj (vlax-ename->vla-object (car Sel)))
      (= (vla-get-objectname Obj) "AcDbText")
      (setq Str (vla-get-textstring Obj))
      (setq Rot (vla-get-rotation Obj))
      (setq Pt (trans (cadr Sel) 1 0))
      (vl-position (vla-get-alignment Obj) '(0 1 2 4 6 7 8 9 10 11 12 13 14))
    )
     (progn
       (setq Ipt (safearray-value (vlax-variant-value(vla-get-insertionpoint obj))))
       (setq pickdist (distance Ipt pt))

       (vla-put-rotation obj 0.0)
       (setq Ipt (safearray-value (vlax-variant-value(vla-get-insertionpoint obj))))
       (setq obj2 (vlax-invoke Obj 'Copy))
       (vla-getboundingbox Obj 'll 'ur)
       (setq ll (safearray-value ll)
             ur (safearray-value ur)
             objul (list (car ll) (cadr ur))
             objlen (distance ur objul))

       (setq idx     (strlen str)
             str2    str
             textlen (1+ pickdist)
       )
       (while (> textlen pickdist)
         (setq str (substr str 1 (setq idx (1- idx))))
         (vla-put-textstring Obj str)
         (vla-getboundingbox Obj 'll 'ur)
         (setq ll (safearray-value ll)
               ur (safearray-value ur))
         (setq textlen (distance (list (car ll) (cadr ur)) ur))
       )
       (setq str2 (substr str2 (1+ (strlen str))))
       (vla-put-textstring obj2 str2)
       (vla-getboundingbox Obj2 'll 'ur)
       (setq ll (safearray-value ll)
             ur (safearray-value ur)
             ofs2 (- objlen (distance ll (list (car ur)(cadr ll)))))
       (setq Ipt1 (safearray-value (vlax-variant-value(vla-get-insertionpoint obj))))
       (setq Ipt2 (safearray-value (vlax-variant-value(vla-get-insertionpoint obj2))))
       
       (vla-put-rotation obj rot)
       (vla-put-rotation obj2 rot)
       (setq acode (vla-get-alignment Obj))
       (cond
         ((vl-position aCode '(0 6 9 12)) ; Left
           (vla-move obj2 (vlax-3d-point objul)(vlax-3D-point (polar objul rot ofs2)))
          )
         ((vl-position aCode '(1 4 7 10 13)) ; Center
           (vla-move obj (vlax-3d-point objul)(vlax-3D-point (polar objul (+ rot pi) (distance ipt ipt1))))
           (vla-move obj2 (vlax-3d-point objul)(vlax-3D-point (polar objul rot (distance ipt ipt2))))
          )
         ((vl-position aCode '(2 8 11 14)) ;Right
           (vla-move obj (vlax-3d-point objul)(vlax-3D-point (polar objul (+ rot pi) (distance ipt ipt1))))
          )
         ) ; end cond stmt
         (setq pt_move (getpoint "\n\nPick insertion point for 2nd text entity: Press <CR> to place below 1st text: "))
         (cond (pt_move (vla-move obj2 (vla-get-insertionpoint obj2)(vlax-3D-point (trans pt_move 1 0)))))
      )
     (cond
       ((not Sel)
        (prompt "\n No object selected.")
       )
       ((not Str)
        (prompt "\n Object selected was not a plain text object.")
       )
       (t
        (prompt
          "\n Text object selected does not have an alignment that would work."
        )
       )
     )
  )
  (vla-endundomark ActDoc)
  (princ)
)

[dbhunia · Accepted solution]

---

@danglar wrote:

First of all I want to thank to       CADaStroumph

for a god solution of this issue

Yes, I modified the original code in order to save dcl file in a temporal directory according to

roamablerootprefix system  variable but is was unsuccessful

Your solution is much  better!

Another question if it possible

I find in my storage stuff (I don't know who create it) another routine for the same goal (see attached lisp)

it working properly for my purposes but I want to add an option to place the "second part " of  text string as it possible in upgraded by your efforts routine...

something like this:

................................

---

Try this........(possibly you may need some modifications, hopefully you can manage it...)

[danglar]

Thank you very much CADaStroumph and       dbhunia

Your solutions are perfect and in a same time comes from a different points of view

Your help is very appreciated by me