需要代码帮助
你好,在我的一个Lisp中,wich是由伟大的Lee创建的:wink:,其中有一段代码用于加载线型。由于我在一个单独的文件(custom_linetypes.lin)中使用了我自己的特定线型,我想修改代码,以便它也可以加载它们。
最简单的方法是更改文件名,但在这种情况下,我需要从acadiso复制线型。lin到custom_线型。为了让他们接近林。
(if (not (tblsearch "LTYPE" ltname))
(vla-load
(vla-get-Linetypes
(vla-get-ActiveDocument
(vlax-get-acad-object))) ltname "acadiso.lin"))
我想最后一行应该修改;其中“acadiso.lin”应该是包含列表的变量。文件列表。。。
但是怎么做?
看起来这不是解决问题的方法:
(setq file1 "acadiso.lin"
file2 "custom_linetype.lin"
file '(a b)
)
对于我来说:
请不要马上给我答案,而是给我指出正确的方向。提前谢谢。
(顺便说一句:如果不成功,你可以随时给我一个答案……) 我在X:\newlinetypesfile中创建了一个文件。林从阿卡迪索那里复制了一个线型。林,并将其重命名为“newlntype”,这起到了作用:
(defun c:test (/ )
(vla-load
(vla-get-Linetypes
(vla-get-ActiveDocument
(vlax-get-acad-object))) "newlntype" "X:\\newlinetypesfile.lin")
)
你就是这么试的吗? 以下是我使用的:
主要功能:
;;; ------------------------------------------------------------------------
;;; 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
)
你需要做的就是
(STDLIB_LOADLINETYPE“linetypename”)
这将搜索所有内容。lin文件位于线型的支持路径中,如果找到它,则加载它并返回T,否则返回nil。 嗨,蒂姆,
我把它们都放在一个单独的lisp文件中并加载了它们,但它似乎不起作用。。
这是urn的命令,对吗?
(STDLIB_LOADLINETYPE "linetypename")
其中线型为“marcow”。
这是我得到的错误:
Command: (STDLIB_LOADLINETYPE "linetypename")
; error: no function definition: STDLIB_LOADLINETYPE
我的错,试试这个电话
(STDLIB_LOAD_线型“LINETYPE”)
忘记了额外的下划线。 嗨,蒂姆,
我现在可以工作了,但我遇到了一个问题。也许你可以帮我。
我在我的代码中添加了你的代码,效果很好。我在一个支持路径中创建了一个自定义线型文件。
工作示例:
*ABC,LINEOFABC
A,25,-5,5,-5
不起作用的示例:
*GAS,LINEOFGAS
A,25,-5,["G",standard,S=2,A=0,X=-.1,Y=-1],-5
问题是当我将“lineofgas”复制到标准acadiso中时。林,它确实管用。
那么,您知道为什么您的代码似乎无法加载有点复杂的线型吗?
哦,顺便说一句,如果我手动加载它,那么浏览到customlintetype。林,我可以加载它,然后它也可以工作。
对不起,我解释得不好。。。 哎呀。。。我的错。
我发现acadiso中已经有一种称为GAS的线型。lin文件。所以我猜这可能会有冲突:我把我的重命名为GAS2,它就解决了。
我想我马上就分享。 我使用
(defun Sub_LTLoad (lTyp)
(or (tblsearch "LTYPE" lTyp)
(vla-load
(vla-get-Linetypes
(vla-get-ActiveDocument
(vlax-get-acad-object)
)
)
lTyp "acad.lin"
)
)
) 提姆,
这段代码是我通常用来将字符串分解为列表的代码。。。采用分隔符的字符串和字符代码(本例中为59)。
;; 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)))
我只是觉得它可能比你拥有的要短。 提姆有点无聊,所以用另一种方式重新编写了你的例程
(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)))
页:
[1]
2