(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)))
快速代码李，一如既往，我建议提醒用户，如果存在重复，并让用户选择从中加载，因为他们是不同的，虽然相同的名称。如果用户仅使用acad，则当前代码没有问题。林。。只是一个建议，干得好…：-）
同意，我经常根据自己的需要使用：
(defun ltype-load (ltyp)
(if (not (tblsearch "ltype" ltyp))
(command "._-linetype" "_l"ltyp
(findfile
(if (= (getvar "measurement") 0)
"acad.lin"
"acadiso.lin")) ""))
(princ)
)
~'J'~
很好的代码修复，谢谢。
谢谢Wiz
也许有点像。。。
(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)))
现在这对我来说很好（尽管这是一个混乱的；-|…）调用命令“createlayer”时。然后我把它们都填好，它就开始工作了。
但是如果我通过宏使用它，那么它确实可以工作，但层不能获得电流。
这是一个以前从未有过的例程，它在宏中的工作方式与在命令栏中的不同。宏位于工具选项板中，这可能就是问题所在。
谁能给我解释一下怎么解决这个问题？（因此，将从toolpalette中使用createlayer函数，以便将其设置为当前）。
提前谢谢。 看起来李已经击败了我，但这里是我的搜索之一。lin文件位于支持搜索路径中。
它在搜索路径中搜索并查找。林文件，并生成一个文件列表，然后查看。
(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
)
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") ";")))) )
页:
1
[2]