Topic: CREATE A CUSTOM LINETYPE USING A LISP?

[stsevedallas]

Can that be done?
Here is what I envision:
1. select a starting and ending point for a line
2. type the text that needs to be inside of the line
3. select a spacing for the text inside of the line (such as every 6' or 10' or whatever, this could also be done with the cursor)
4. name the line type
5. maybe have the color and weight by layer
6. I guess the text style could be included in the lisp, if you want another...just change it in the lisp.

Goal: Automate creating a new linetype. Kind of a pain, especially with spacing, etc.

[GDF]

Try this...

Code: [Select]

;Tip1469.LSP:    TXA.LSP    Insert Text    (C)1998, Angelito S. Rivera

Gary


[ Moderator Action: Code removed due to potential Copyright Issues ]
Source Code can be found here
http://tinyurl.com/z6ehb

or here
http://new.cadalyst.com/code/

[CAB]

And another:

http://www.theswamp.org/index.php?topic=4766.msg57563#msg57563

[stsevedallas]

This is the latter code and it gives this this output-
Enter line text: <XX>
*XX,XX----XX----XX----XX
A,.5,-.2,["XX",STANDARD,S=.1,R=0.0,X=-0.1,Y=-.05],-0.2

Error: bad argument type: streamp nil

Code: [Select]

;================================================================================
;D. Marker 10-08-1999
;================================================================================
(defun c:ltxt ()
 (setvar "cmdecho" 0)
 (setq v:clayer (getvar "clayer"))
 (setq v:expert (getvar "expert"))
 (if (not v:linet)
   (setq v:linet "XX")
 ) ;if
 (setq v:linet_x (getstring (strcat "\n \n \nEnter line text: <" v:linet ">")))
 (if (/= v:linet_x "")
   (setq v:linet (strcase v:linet_x))
 ) ;if
 (setq v:linet (strcase v:linet))
 (setvar "expert" 4)
 (setq v:linet_l (strlen v:linet))
 (setq v:linet_w (rtos (* v:linet_l 0.1) 2 1))
 (setq v:lt_file "c:\\temp\\lt_temp.lin")
 (setq v:lt_var1 (open v:lt_file "w"))
 (setq v:lt_textl1 (strcat "*" v:linet "," v:linet "----" v:linet "----" v:linet
                         "----" v:linet
                   ));setq
 (setq v:lt_textl2 (strcat "A,.5,-.2,[" (chr 34) v:linet (chr 34)
                         ",STANDARD,S=.1,R=0.0,X=-0.1,Y=-.05],-" v:linet_w
                   ));setq
 (setq v:lt_var2 (write-line v:lt_textl1 v:lt_var1))
 (setq v:lt_var3 (write-line v:lt_textl2 v:lt_var1))
 (close v:lt_var1)
 (command "-linetype" "l" v:linet v:lt_file "")
 (setvar "expert" v:expert)
 (command ".celtype" v:linet)
 (princ (strcat "\n \n \nCurrent Entity linetype set to:" v:linet))
 (princ)
 (setq v:pnt1 (getpoint "\nPick start point:"))
 (command "pline" v:pnt1)
 (while (setq v:pt (getpoint (getvar "lastpoint")
                           "\nNext point or <Return to terminate>:"
                   ));getpoint, setq
   (command v:pt)
 ) ;while
 (command)
 (command)
 (setvar "celtype" "bylayer")
 (princ)
 (princ "\n \nLine-Text terminated.  Linetype set to BYLAYER:")
 (princ)
) ;defun
(princ)
(princ " Line-Text Loaded...")
(princ)
(princ (strcat "\n \n" (chr 34) "LTXT" (chr 34) " to execute:"))
(princ)

<CODE TAGS ADDED>

[CAB]

Just tried it in ACAD200. Worked fine.

Perhaps you don't have this directory in your system  c:\\temp\\

[stsevedallas]

I added that directory, and it did it.
However, spacing is strange though.
What LT scale do YOU usually run at?
We are at ltscale=1/2-dimscale
or sometimes
ltscale=1
The text overlaps...and is too close.

[CAB]

Typically LTScale = 48

[stsevedallas]

got it.
Thank you for the code and help.

[stsevedallas]

I just brought this routine to my home PC.
At home I get:
Error: bad argument type: streamp nil
It stops as it is about to create the "lin" file...so it is not created.

What is going on here?
I am sure it is probably a setting or something that is different on this PC.
Thank you in advance.

[CAB]

Perhaps you don't have this directory in your system  c:\\temp\\

[stsevedallas]

oops...did not realize that I asked the same question earlier.  I tried calling the new line "cc", when prompted, just to test.

Now it says this:
Bad definition of "CC" at line 2 of file C:\temp\lt_temp.lin

Cannot set CELTYPE to that value.
*Invalid*
 :realmad:

[CAB]

I had no problem:

Code: [Select]

*CC,CC----CC----CC----CC
A,.5,-.2,["CC",STANDARD,S=.1,R=0.0,X=-0.1,Y=-.05],-0.2

[CADmium]

another sample

[Sdoman]

...
Bad definition of "CC" at line 2 of file C:\temp\lt_temp.lin
...

Just a guess, check that the drawing contains a textstyle named "standard".
 

[CAB]

Here is a revised version of the routine to detect some of the errors that may occur.

Code: [Select]

;;================================================================================
;;  Original routine by D. Marker 10-08-1999
;;  revised by CAB 04/21/2006
;;  Added:
;;    Error handler
;;    Text style create
;;    Check for illegal characters in linetype
;;    Delete temp file
;;    Removed dependency on folder C:/temp
;;================================================================================
(defun c:ltxt (/ clayer expert linet_w linet_x lt_file lt_fname lt_textl1 lt_textl2 lt_var2 lt_var3 pnt pt tstyle
              )
  ;; error function & Routine Exit
  (defun *error* (msg)
    (if
      (not
        (member
          msg
          '("console break" "Function cancelled" "quit / exit abort" "")
        )
      )
       (princ (strcat "\nError: " msg))
    )

    ;;reset all variables here
    (setvar "expert" expert)
    (setvar "clayer" clayer)
    (setvar "celtype" "bylayer")
    (setvar "CMDECHO" usercmd)
  ) ;end error function

  ;;  check for invaild characters "\"*,/:;<=>?\\`|"
  (defun badchar (name / flag)
    (mapcar '(lambda (x)
               (if (vl-position x '(34 42 44 47 58 59 60 61 62 63 92 96 124))
                 (setq flag t)
               )
             )
            (vl-string->list name)
    )
    flag
  )

  (setq usercmd (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (setq clayer (getvar "clayer"))
  (setq expert (getvar "expert"))
  (or linet (setq linet "XX"))
  ;;  get line label, disallow numbers as first character
  (while
    (progn
      (setq linet_x (getstring t (strcat "\nEnter line text: <" linet ">")))
      (if (/= linet_x "")
        (setq linet linet_x)
      )
      (if (badchar linet)
        (not (alert "ERROR - Bad character in name."))
        nil
      )
    )
  )
  ;; (setq linet (strcase linet))
  (setvar "expert" 4)
  (setq linet_w (rtos (* (strlen linet) 0.1) 2 1))
  (if (or (tblsearch "style" "STANDARD")
          (entmake
            (list
              '(0 . "STYLE") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbTextStyleTableRecord") '(2 "STANDARD")
              '(70 . 0) '(40 . 0.0) '(41 . 1.0) '(50 . 0.0) '(71 . 0) '(42 . 5.0) '(3 . "simplex") '(4 . "")
             )
          )
      )
    (setq tstyle "STANDARD")
    (progn
      (alert "ERROR creating Standard Text Style")
      (*error* "") ; reset vars
      (exit)
    )
  )
  ;;  create a temp file & save the path to it
  (setq lt_file (strcat (getvar "SAVEFILEPATH") "\\Temp.lin"))
  (setq lt_fname (open lt_file "w"))
  (setq lt_textl1 (strcat "*" linet "," linet "----" linet "----" linet "----" linet))
  (setq lt_textl2 (strcat "A,.5,-.2,[\"" linet "\"," tstyle ",S=.1,R=0.0,X=-0.1,Y=-.05],-" linet_w
                         )
  )
  (setq lt_var2 (write-line lt_textl1 lt_fname))
  (setq lt_var3 (write-line lt_textl2 lt_fname))
  (close lt_fname)
  ;; load the linetype
  (command "-linetype" "l" linet lt_file "")

  ;;  remove the temp file
  (vl-file-delete (findfile lt_file))

  (setvar "expert" expert)
  (command ".celtype" linet)
  (princ (strcat "\nCurrent Entity linetype set to:" linet))
  (princ)

  ;;  Create a pline with the new linetype
  (if (setq pnt (getpoint "\nPick start point:"))
    (progn
      (command "pline" pnt)
      (while (setq pt (getpoint (getvar "lastpoint")
                                "\nNext point or <Return to terminate>:"
                      )
             )
        (command pt)
      )
      (command)
      (command)
    )
  )
  (*error* "") ; reset vars
  (princ)
  (princ "\n \nLine-Text terminated.  Linetype set to BYLAYER:")
  (princ)
)
(princ " \n Line-Text Loaded... Enter LTXT to execute:")
(princ)

[hudster]

This didn't work for me

error message

Code: [Select]

Enter line text: <EXISTING>

"C:\DOCUME~1\ANDY~1.HUD\LOCALS~1\Temp\\Temp.lin": Invalid file name.

Error: bad argument type: stringp nil
Also would it be pissible to change this lisp so that the text height could be specified? for the LTscale we use the scale of the drawing, so a text height of  is unreadable.

[CAB]

See this line.

Code: [Select]

(setq lt_textl2 (strcat "A,.5,-.2,[\"" linet "\"," tstyle ",S=.1,R=0.0,X=-0.1,Y=-.05],-" linet_w
The S=.1 is the text height when the Text Style height is zero. Otherwise that value is multiplied by the text height.
The value is then multiplied by the LTscale. Because my LTscale is 48 the resulting text height is (48 * .1)= 4.8"
So adjust that S=.1 to suite you situation.

And for the file error try this version.

Code: [Select]

;;================================================================================
;;  Original routine by D. Marker 10-08-1999
;;  revised by CAB 04/21/2006
;;  Added:
;;    Error handler
;;    Text style create
;;    Check for illegal characters in linetype
;;    Delete temp file
;;    Removed dependency on folder C:/temp
;;  Rev 04/25/06
;;    Changed Temp file location
;;   
;;================================================================================
(defun c:ltxt (/ clayer expert linet_w linet_x lt_file lt_fname lt_textl1 lt_textl2
               lt_var2 lt_var3 pnt pt tstyle acadfn
              )
  ;; error function & Routine Exit
  (defun *error* (msg)
    (if
      (not
        (member
          msg
          '("console break" "Function cancelled" "quit / exit abort" "")
        )
      )
       (princ (strcat "\nError: " msg))
    )

    ;;reset all variables here
    (setvar "expert" expert)
    (setvar "clayer" clayer)
    (setvar "celtype" "bylayer")
    (setvar "CMDECHO" usercmd)
  ) ;end error function

  ;;  check for invaild characters "\"*,/:;<=>?\\`|"
  (defun badchar (name / flag)
    (mapcar '(lambda (x)
               (if (vl-position x '(34 42 44 47 58 59 60 61 62 63 92 96 124))
                 (setq flag t)
               )
             )
            (vl-string->list name)
    )
    flag
  )

  (setq usercmd (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (setq clayer (getvar "clayer"))
  (setq expert (getvar "expert"))
  (or linet (setq linet "XX"))
  ;;  get line label, disallow numbers as first character
  (while
    (progn
      (setq linet_x (getstring t (strcat "\nEnter line text: <" linet ">")))
      (if (/= linet_x "")
        (setq linet linet_x)
      )
      (if (badchar linet)
        (not (alert "ERROR - Bad character in name."))
        nil
      )
    )
  )
  ;; (setq linet (strcase linet))
  (setvar "expert" 4)
  (setq linet_w (rtos (* (strlen linet) 0.1) 2 1))
  (if (or (tblsearch "style" "STANDARD")
          (entmake
            (list
              '(0 . "STYLE") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbTextStyleTableRecord") '(2 "STANDARD")
              '(70 . 0) '(40 . 0.0) '(41 . 1.0) '(50 . 0.0) '(71 . 0) '(42 . 5.0) '(3 . "simplex") '(4 . "")
             )
          )
      )
    (setq tstyle "STANDARD")
    (progn
      (alert "ERROR creating Standard Text Style")
      (*error* "") ; reset vars
      (exit)
    )
  )
 
  ;;  create a temp file & save the path to it
  (setq acadfn  (findfile "ACAD.PAT")
        lt_file (strcat (substr acadfn 1 (- (strlen acadfn) 8))"Temp.lin")
  )
  ;;(setq lt_file (strcat (getvar "SAVEFILEPATH") "/Temp.lin"))
  (setq lt_fname (open lt_file "w"))
  (setq lt_textl1 (strcat "*" linet "," linet "----" linet "----" linet "----" linet))
  (setq lt_textl2 (strcat "A,.5,-.2,[\"" linet "\"," tstyle ",S=.1,R=0.0,X=-0.1,Y=-.05],-" linet_w))
  (setq lt_var2 (write-line lt_textl1 lt_fname))
  (setq lt_var3 (write-line lt_textl2 lt_fname))
  (close lt_fname)
  ;; load the linetype
  (command "-linetype" "l" linet lt_file "")

  ;;  remove the temp file
  (vl-file-delete (findfile lt_file))

  (setvar "expert" expert)
  (command ".celtype" linet)
  (princ (strcat "\nCurrent Entity linetype set to:" linet))
  (princ)

  ;;  Create a pline with the new linetype
  (if (setq pnt (getpoint "\nPick start point:"))
    (progn
      (command "pline" pnt)
      (while (setq pt (getpoint (getvar "lastpoint")
                                "\nNext point or <Return to terminate>:"))
        (command pt)
      )
      (command)
      (command)
    )
  )
  (*error* "") ; reset vars
  (princ)
  (princ "\n \nLine-Text terminated.  Linetype set to BYLAYER:")
  (princ)
)
(princ " \n Line-Text Loaded... Enter LTXT to execute:")
(princ)

[hudster]

CAB you are the man

Here is the modified version for a text height of 1.5

Code: [Select]

;;================================================================================
;;  Original routine by D. Marker 10-08-1999
;;  revised by CAB 04/21/2006
;;  Added:
;;    Error handler
;;    Text style create
;;    Check for illegal characters in linetype
;;    Delete temp file
;;    Removed dependency on folder C:/temp
;;  Rev 04/25/06
;;    Changed Temp file location
;;   
;;================================================================================
(defun c:ltxt (/ clayer expert linet_w linet_x lt_file lt_fname lt_textl1 lt_textl2
               lt_var2 lt_var3 pnt pt tstyle acadfn)
  ;; error function & Routine Exit
  (defun *error* (msg)
    (if
      (not
        (member
          msg
          '("console break" "Function cancelled" "quit / exit abort" "")
        )
      )
       (princ (strcat "\nError: " msg))
    )

    ;;reset all variables here
    (setvar "expert" expert)
    (setvar "clayer" clayer)
    (setvar "celtype" "bylayer")
    (setvar "CMDECHO" usercmd)
  ) ;end error function

  ;;  check for invaild characters "\"*,/:;<=>?\\`|"
  (defun badchar (name / flag)
    (mapcar '(lambda (x)
               (if (vl-position x '(34 42 44 47 58 59 60 61 62 63 92 96 124))
                 (setq flag t)
               )
             )
            (vl-string->list name)
    )
    flag
  )

  (setq usercmd (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (setq clayer (getvar "clayer"))
  (setq expert (getvar "expert"))
  (or linet (setq linet "XX"))
  ;;  get line label, disallow numbers as first character
  (while
    (progn
      (setq linet_x (getstring t (strcat "\nEnter line text: <" linet ">")))
      (if (/= linet_x "")
        (setq linet linet_x)
      )
      (if (badchar linet)
        (not (alert "ERROR - Bad character in name."))
        nil
      )
    )
  )
  ;; (setq linet (strcase linet))
  (setvar "expert" 4)
  (setq linet_w (rtos (* (strlen linet) 2) 2 1))
  (if (or (tblsearch "style" "STANDARD")
          (entmake
            (list
              '(0 . "STYLE") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbTextStyleTableRecord") '(2 "STANDARD")
              '(70 . 0) '(40 . 0.0) '(41 . 1.0) '(50 . 0.0) '(71 . 0) '(42 . 5.0) '(3 . "simplex") '(4 . "")
             )
          )
      )
    (setq tstyle "STANDARD")
    (progn
      (alert "ERROR creating Standard Text Style")
      (*error* "") ; reset vars
      (exit)
    )
  )
 
  ;;  create a temp file & save the path to it
  (setq acadfn  (findfile "ACAD.PAT")
        lt_file (strcat (substr acadfn 1 (- (strlen acadfn) 8))"Temp.lin")
  )
  ;;(setq lt_file (strcat (getvar "SAVEFILEPATH") "/Temp.lin"))
  (setq lt_fname (open lt_file "w"))
  (setq lt_textl1 (strcat "*" linet "," linet "----" linet "----" linet "----" linet))
  (setq lt_textl2 (strcat "A,5,-1,[\"" linet "\"," tstyle ",S=1.5,R=0.0,X=0.75,Y=-.75],-" linet_w))
  (setq lt_var2 (write-line lt_textl1 lt_fname))
  (setq lt_var3 (write-line lt_textl2 lt_fname))
  (close lt_fname)
  ;; load the linetype
  (command "-linetype" "l" linet lt_file "")

  ;;  remove the temp file
  (vl-file-delete (findfile lt_file))

  (setvar "expert" expert)
  (command ".celtype" linet)
  (princ (strcat "\nCurrent Entity linetype set to:" linet))
  (princ)

  ;;  Create a pline with the new linetype
  (if (setq pnt (getpoint "\nPick start point:"))
    (progn
      (command "pline" pnt)
      (while (setq pt (getpoint (getvar "lastpoint")
                                "\nNext point or <Return to terminate>:"))
        (command pt)
      )
      (command)
      (command)
    )
  )
  (*error* "") ; reset vars
  (princ)
  (princ "\n \nLine-Text terminated.  Linetype set to BYLAYER:")
  (princ)
)
(princ " \n Line-Text Loaded... Enter LTXT to execute:")
(princ)

[CAB]

Glad I could help.