[编程交流] 需要代码帮助

(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)))

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

(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)))

 
(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
)

( (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") ";")))) )