Help needed with piece of code to load linetype

Hi there,

In one of my lisps, wich was created by the great Lee :wink:, there is a piece of code to load a linetype. Since I use my own specific linetypes in a seperate file (custom_linetypes.lin) I would like to alter the code so it can load them as well.

The most easy way would be to change the filename but in that case I will need to copy the linetypes from acadiso.lin to custom_linetypes.lin in order to have them accessible.

(if (not (tblsearch "LTYPE" ltname))
(vla-load
(vla-get-Linetypes
(vla-get-ActiveDocument
(vlax-get-acad-object))) ltname "acadiso.lin"))

I guess that the last line should be modified; where "acadiso.lin" should be a variable that contains a list. A list of files...

But how?

Looks like this is not the way to approach it:

(setq file1 "acadiso.lin"
       file2 "custom_linetype.lin"
       file '(a b)
)

For I get this:

; error: lisp value has no coercion to VARIANT with this type: (A B)

Please do not give me the answer right away but point me in the right direction. Thanks in advance.

(btw.: if not successful you can always provide me an answer...)

I made a file in X:\ called newlinetypesfile.lin and copied a linetype from acadiso.lin and renamed it "newlntype" and this worked:

(defun c:test (/ )
 (vla-load
   (vla-get-Linetypes
     (vla-get-ActiveDocument
   (vlax-get-acad-object))) "newlntype" "X:\\newlinetypesfile.lin")
 )

Is that exactly what you tried?

Here is what I use:

The Main Function:

;;; ------------------------------------------------------------------------
;;;    STDLIB_LOAD_LINETYPE.LSP
;;;
;;;    Copyright © December, 2008
;;;    Timothy G. Spangler
;;;
;;;    Permission to use, copy, modify, and distribute this software
;;;    for any purpose and without fee is hereby granted, provided
;;;    that the above copyright notice appears in all copies and
;;;    that both that copyright notice and the limited warranty and
;;;    restricted rights notice below appear in all supporting
;;;    documentation.
;;;
;;;    STDLIB_LOAD_LINETYPE
;;;
;;;		 Description:
;;;			Called from a menu pulldown or rightclick menu
;;;		* (STDLIB_LOAD_LINETYPE <LINETYPE>)
;;;		<LINETYPE>			=	STRING	=	Valid linetype
;;;
;;;			Returns:
;;;				T if found and loaded otherwise nil
;;;
;;; ------------------------------------------------------------------------

;;; MAIN FUNCTION ;;;;;;;;;;;;;;;;;;;;;;;;;
(defun STDLIB_LOAD_LINETYPE (Linetype / OldCmdEcho LineFiles FullFile Found OpenFile CurrentLine LinePath Result)

;; Set system variables
(setq OldCmdEcho (getvar "CMDECHO"))
(setvar "CMDECHO" 0)

;; Load linetype
(if (not (tblsearch "LTYPE" Linetype))
	(progn
		;; Check each search path for a .lin file
		(foreach Path (STR->LIST (getenv "ACAD") ";")
			(if (setq LineFiles (vl-directory-files Path "*.lin"))
				(progn
					(foreach File LineFiles
						(setq FullFile (cons (strcat Path "\\" File) FullFile))
					)
					(setq Found (cons Path Found))
				)
			)
		)
		;; Read each line file found and check for the linetype
		(foreach LineFile FullFile
			(setq OpenFile (open LineFile "r"))
			(while (setq CurrentLine (read-line OpenFile))
				(if (wcmatch (strcase CurrentLine) (strcat "*" (strcase LineType) "*"))
					(setq LinePath Linefile)
				)
			)
			(close OpenFile)
		)
		;; Load result
		(if LinePath	
			(setq Result T)					
			(setq Result nil)
		)
	)
)
(if Result
	;(command "-linetype" "load" Linetype LinePath "")
	(vl-cmdf "-linetype" "load" Linetype LinePath "")
)
;; Reset system
(setvar "CMDECHO" OldCmdEcho)
;; Send Result
Result
)
(princ)

A Little Helper:

;;; ------------ STRING TO LIST SUB ROUTINE, CREATE A LIST FROM A STRING WITH DELIMETER
(defun STR->LIST (Stg Del / CurChr PosCnt TmpLst TmpStr NewTmpLst)

(setq PosCnt 1)
(setq TmpStr "")

(repeat (1+ (strlen Stg))
	(setq CurChr (substr Stg PosCnt 1))
	(if (= CurChr Del)
		(progn
			(setq TmpLst (cons TmpStr TmpLst))
			(setq TmpStr "")
		)
		(setq TmpStr (strcat TmpStr CurChr))
	)
	(setq PosCnt (1+ PosCnt))
)
(if (/= TmpStr "")
	(setq TmpLst (cons TmpStr TmpLst))
)
(setq NewTmpLst (reverse TmpLst))
NewTmpLst
)

all you need to do is

(STDLIB_LOADLINETYPE "linetypename")

This will search through ALL .lin files in your support path for the linetype if it finds it it loads it and returns T otherwise it returns nil.

Hi Tim,

I've put both of them in a seperate lisp file and loaded them but it don't seem to work..

This is the command to urn it am I right?

 
(STDLIB_LOADLINETYPE "linetypename")

Where linetype is ie. "marcow".

This is the error I get:

 

Command: (STDLIB_LOADLINETYPE "linetypename")
; error: no function definition: STDLIB_LOADLINETYPE

My bad Try this call instead

(STDLIB_LOAD_LINETYPE "linetype")

Forgot the extra underscore.

Hi Tim,

I got it working now but I encounter one problem. Maybe you can help me out.

I added your code in one of mine and it works great. I have made a custom linetype file in one of the support path's.

Example that works:

 
*ABC,LINEOFABC
A,25,-5,5,-5

Example that does not work:

 
*GAS,LINEOFGAS
A,25,-5,["G",standard,S=2,A=0,X=-.1,Y=-1],-5

The thing is when I copy "lineofgas" into the standard acadiso.lin it does work.

So do you have a clue why your code doesn't seem to be able to load a bit complex linetype?

Oh, by the way, if I'd load it manually, so browse to customlintetype.lin I can load it and then it works as well.

Sorry for my poor explaination...

Oops... my bad.

I found out that there is already a linetype called GAS in the acadiso.lin file. So I guessed it might conflict: I renamed mine to GAS2 and it is solved.

I thought I share it right away.

I use

(defun Sub_LTLoad (lTyp)
 (or (tblsearch "LTYPE" lTyp)
  (vla-load
   (vla-get-Linetypes
    (vla-get-ActiveDocument
     (vlax-get-acad-object)
    )
   ) 
   lTyp "acad.lin"
  )
 )
)

Tim,

This code is what I usually use to break strings into Lists... takes the string and character code of delimiter (59 in your case).

;; String Breaker by Lee McDonnell
(defun StrBrk (str chrc / pos lst)
 (while (setq pos (vl-string-position chrc str))
   (setq lst (cons (substr str 1 pos) lst)
         str (substr str (+ pos 2))))
 (reverse (cons str lst)))

Just thought it might be shorter than what you have.

Was a bit bored Tim, so re-wrote your routine in another way

(defun lt_load (ltname / StrBrk lt Path files lst)

 ;; String Breaker by Lee McDonnell
 (defun StrBrk (str chrc / pos lst)
   (while (setq pos (vl-string-position chrc str))
     (setq lst (cons (substr str 1 pos) lst)
           str (substr str (+ pos 2))))
   (reverse (cons str lst)))

 (setq lt (vla-get-linetypes (vla-get-ActiveDocument (vlax-get-acad-object))))

 (if (not (tblsearch "LTYPE" ltname))
   (progn
     (foreach Path (vl-remove "" (StrBrk (getenv "ACAD") 59))
       (and (setq files (vl-directory-files Path "*.lin" 1))
            (setq lst   (append lst (mapcar (function (lambda (x) (strcat Path "\\" x))) files)))))

     (foreach file lst
       (vl-catch-all-apply 'vla-load (list lt ltname file)))))

 (and (tblsearch "LTYPE" ltname)))

May be a check could also be added if a linetype is present in multiple .lin files. For example the linetype HIDDEN, which is both present in ACAD.lin and ACADISO.lin but they are different.

This should print a list of all duplicate definitions found:

(defun lt_doups (/ StrBrk Path files lst tmp nl lLst)

 ;; String Breaker by Lee McDonnell
 (defun StrBrk (str chrc / pos lst)
   (while (setq pos (vl-string-position chrc str))
     (setq lst (cons (substr str 1 pos) lst)
           str (substr str (+ pos 2))))
   (reverse (cons str lst)))

 (foreach Path (vl-remove "" (StrBrk (getenv "ACAD") 59))
   (and (setq files (vl-directory-files Path "*.lin" 1))
        (setq lst   (append lst (mapcar (function (lambda (x) (strcat Path "\\" x))) files)))))

 (foreach file lst
   (setq tmp (open file "r"))
   (while (setq nl (read-line tmp))
     (and (eq "*"  (substr nl 1 1))
          (setq llst (cons (cons (car (StrBrk (substr nl 2) 44))
                                 (vl-filename-base file)) llst))))
   (close tmp))

 (setq k -1)
 (foreach x
   (vl-sort
     (vl-remove-if-not
       (function
         (lambda (x / remove_nth)
           (defun remove_nth (i lst / j)
             (setq j -1)
               (vl-remove-if
                 (function
                   (lambda (y)
                     (eq i (setq j (1+ j))))) lst))
           (vl-position (car x)
             (mapcar (function car)
                     (remove_nth (setq k (1+ k)) lLst))))) lLst)
     (function (lambda (a b) (< (car a) (car b)))))
   (print x)))

Quick Code Lee, as always, Im suggesting to alert the user if duplicates are present and have the user pick from which to load since they are different though same name. The present code is fine if the user is using only acad.lin. ..just a suggestion, good work ...:-)

May be a check could also be added if a linetype is present in multiple .lin files. For example the linetype HIDDEN, which is both present in ACAD.lin and ACADISO.lin but they are different.

Agreed, I use often for my own needs:

(defun ltype-load (ltyp)
(if (not (tblsearch "ltype" ltyp))
(command "._-linetype" "_l"  ltyp
(findfile 
(if (= (getvar "measurement") 0)
 "acad.lin"
 "acadiso.lin")) ""))
(princ)
 )

~'J'~

Agreed, I use often for my own needs:

(defun ltype-load (ltyp)
(if (not (tblsearch "ltype" ltyp))
(command "._-linetype" "_l"  ltyp
(findfile 
(if (= (getvar "measurement") 0)
 "acad.lin"
 "acadiso.lin")) ""))
(princ)
 )

~'J'~

Good Code fixo, thanks.

Quick Code Lee, as always, Im suggesting to alert the user if duplicates are present and have the user pick from which to load since they are different though same name. The present code is fine if the user is using only acad.lin. ..just a suggestion, good work ...:-)

Thanks Wiz

Quick Code Lee, as always, Im suggesting to alert the user if duplicates are present and have the user pick from which to load since they are different though same name. The present code is fine if the user is using only acad.lin. ..just a suggestion, good work ...:-)

Perhaps something like...

(defun lt_load (ltname / StrBrk DCTAG F FILES FLAG FN L LLST LST NL PATH TFILE TMP)

 ;; String Breaker by Lee McDonnell
 (defun StrBrk (str chrc / pos lst)
   (while (setq pos (vl-string-position chrc str))
     (setq lst (cons (substr str 1 pos) lst)
           str (substr str (+ pos 2))))
   (reverse (cons str lst)))

 (foreach Path (vl-remove "" (StrBrk (getenv "ACAD") 59))
   (and (setq files (vl-directory-files Path "*.lin" 1))
        (setq lst   (append lst (mapcar (function (lambda (x) (strcat Path "\\" x))) files)))))

 (foreach file lst
   (setq tmp (open file "r"))
   (while (setq nl (read-line tmp))
     (and (eq "*"  (substr nl 1 1))
          (eq (strcase ltname)
              (setq l (strcase (car (StrBrk (substr nl 2) 44)))))
          (setq llst (cons (cons l (strcat (vl-filename-base file) ".lin")) llst))))
   (close tmp))

 (if lLst
   (if (< 1 (length lLst))
     (progn
       (setq fn (open (setq tfile (vl-filename-mktemp "" "" ".dcl")) "w"))
       (foreach str '("lt_dcl : dialog { label = \"Select Load File\"; spacer;"
                      ": popup_list { alignment = centered; key = \"flin\"; } spacer; ok_cancel; } ")
         (write-line str fn))
       (close fn)

       (if (and (<= 0 (setq dcTag (load_dialog tFile)))
                (new_dialog "lt_dcl" dcTag))
         (progn

           (start_list "flin")
           (mapcar 'add_list (mapcar 'cdr lLst)) (end_list)
           (setq f (car lLst))

           (action_tile "flin"   "(setq f (nth (atoi $value) lLst))")
           (action_tile "accept" "(done_dialog 1)")
           (action_tile "cancel" "(done_dialog 0)")

           (setq flag (start_dialog))
           (unload_dialog dcTag)))

       (vl-file-delete tfile))

     (setq flag 1 f (car lLst))))

 (if (eq flag 1)
   (vla-load
     (vla-get-linetypes
       (vla-get-ActiveDocument
         (vlax-get-acad-object))) (car f) (cdr f)))

 (and (tblsearch "LTYPE" ltname)))

The only bug that I am aware of with the above code is that an existing linetype will not "reload", (information gathered from CAB at theSwamp.org.

I have put this all together and came up with this:

 
(defun c:createlayer (/ ltname layname laycol cmdold lay)
 (vl-load-com)
(command "-linetype" "s" "bylayer" ""); in case if not bylayer
 (setq ltname (getstring "\nPlease enter the name of the linetype: ")
       layname (getstring "\nPlease enter the name of the layer: ")
       laycol (getint "\nPlease enter the colour of the layer: ")
layplot (getstring "\nDo you want the layer to be <Plot> or <Non plot>: ")
       cmdold (getvar "CMDECHO"))
 (setvar "CMDECHO" 0)
;switch to timothy's code
(STDLIB_LOAD_LINETYPE ltname)
 ;; Loading Linetype  ~ Another option to consider:
 (if (not (tblsearch "LTYPE" ltname))
   (vla-load
     (vla-get-Linetypes
       (vla-get-ActiveDocument
         (vlax-get-acad-object))) ltname "acadiso.lin"))
 ;; Layer Checking & Creation
 (if (not (tblsearch "LAYER" layname))
   (command "_.-layer" "_M" layname "_L" ltname layname "_C" laycol layname "_P" layplot "" "")
   (setvar "CLAYER" layname))

 ;; Reset CMDECHO
 (setvar "CMDECHO" cmdold)
 (setvar "CECOLOR" "bylayer")
 (princ))
;;; ------------------------------------------------------------------------
;;;    STDLIB_LOAD_LINETYPE.LSP
;;;
;;;    Copyright © December, 2008
;;;    Timothy G. Spangler
;;;
;;;    Permission to use, copy, modify, and distribute this software
;;;    for any purpose and without fee is hereby granted, provided
;;;    that the above copyright notice appears in all copies and
;;;    that both that copyright notice and the limited warranty and
;;;    restricted rights notice below appear in all supporting
;;;    documentation.
;;;
;;;    STDLIB_LOAD_LINETYPE
;;;
;;;   Description:
;;;   Called from a menu pulldown or rightclick menu
;;;  * (STDLIB_LOAD_LINETYPE <LINETYPE>)
;;;  <LINETYPE>   = STRING = Valid linetype
;;;
;;;   Returns:
;;;    T if found and loaded otherwise nil
;;;
;;; ------------------------------------------------------------------------
;;; MAIN FUNCTION ;;;;;;;;;;;;;;;;;;;;;;;;;
(defun STDLIB_LOAD_LINETYPE (Linetype / OldCmdEcho LineFiles FullFile Found OpenFile CurrentLine LinePath Result)
;; Set system variables
(setq OldCmdEcho (getvar "CMDECHO"))
(setvar "CMDECHO" 0)

;; Load linetype
(if (not (tblsearch "LTYPE" Linetype))
 (progn
  ;; Check each search path for a .lin file
  (foreach Path (STR->LIST (getenv "ACAD") ";")
   (if (setq LineFiles (vl-directory-files Path "*.lin"))
    (progn
     (foreach File LineFiles
      (setq FullFile (cons (strcat Path "\\" File) FullFile))
     )
     (setq Found (cons Path Found))
    )
   )
  )
  ;; Read each line file found and check for the linetype
  (foreach LineFile FullFile
   (setq OpenFile (open LineFile "r"))
   (while (setq CurrentLine (read-line OpenFile))
    (if (wcmatch (strcase CurrentLine) (strcat "*" (strcase LineType) "*"))
     (setq LinePath Linefile)
    )
   )
   (close OpenFile)
  )
  ;; Load result
  (if LinePath 
   (setq Result T)     
   (setq Result nil)
  )
 )
)
(if Result
 ;(command "-linetype" "load" Linetype LinePath "")
 (vl-cmdf "-linetype" "load" Linetype LinePath "")
)
;; Reset system
(setvar "CMDECHO" OldCmdEcho)
;; Send Result
Result
)
(princ)
;;; ------------ STRING TO LIST SUB ROUTINE, CREATE A LIST FROM A STRING WITH DELIMETER
(defun STR->LIST (Stg Del / CurChr PosCnt TmpLst TmpStr NewTmpLst)
(setq PosCnt 1)
(setq TmpStr "")

(repeat (1+ (strlen Stg))
 (setq CurChr (substr Stg PosCnt 1))
 (if (= CurChr Del)
  (progn
   (setq TmpLst (cons TmpStr TmpLst))
   (setq TmpStr "")
  )
  (setq TmpStr (strcat TmpStr CurChr))
 )
 (setq PosCnt (1+ PosCnt))
)
(if (/= TmpStr "")
 (setq TmpLst (cons TmpStr TmpLst))
)
(setq NewTmpLst (reverse TmpLst))
NewTmpLst
)

Now this is working good for me (allthough it is a messy one ;-| ...) when invoking the command "createlayer". THen I just fill em all in and it is working.

But if I use it thrue a macro, then it does work but the layer doesn't get current.

Never had this before, a routine that works different in a macro as in command bar. The macro is in a toolpalette, maybe that is the problem.

Can anyone explain to me how this can be solved? (So the createlayer function is to be used from the toolpalette so that is is set current).

Thanks in advance.

Looks like LeeMac beat me to it already but here is one of my searches for all .lin files in the support search path.

Itterates thru the search path and look for .lin files and generate a list of files to then look thru.

( (lambda ( / )
  (apply
   ;; itterate thru the entire search path to look for .lin files
   'append
   (mapcar
    '(lambda ( x / tmp-str)
            (setq tmp-str (vl-directory-files x "*.lin" 1))
            (if (and tmp-str (not (eq ";" x)))
             (list
              (strcat
               x
               "\\"
               (car tmp-str)))) )
    ( (lambda (aStr delim)
       (while 
        (setq pos (vl-string-search delim aStr 0))
        (setq strList (cons (substr aStr 1 pos) strList)
         strList (cons (substr aStr (1+ pos) (strlen delim)) strList)
         aStr (substr aStr (+ pos (1+ (strlen delim)))))
       )
       (reverse (cons aStr strList)))
      (getvar "ACADPREFIX") ";")))) )