MarcoW 发表于 2022-7-6 11:18:29

需要代码帮助

你好,
 
在我的一个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)
)
 
对于我来说:
 
 
请不要马上给我答案,而是给我指出正确的方向。提前谢谢。
 
(顺便说一句:如果不成功,你可以随时给我一个答案……)

SteveK 发表于 2022-7-6 11:24:24

我在X:\newlinetypesfile中创建了一个文件。林从阿卡迪索那里复制了一个线型。林,并将其重命名为“newlntype”,这起到了作用:
 
(defun c:test (/ )
(vla-load
   (vla-get-Linetypes
   (vla-get-ActiveDocument
   (vlax-get-acad-object))) "newlntype" "X:\\newlinetypesfile.lin")
)
 
你就是这么试的吗?

TimSpangler 发表于 2022-7-6 11:25:43

以下是我使用的:
 
主要功能:

;;; ------------------------------------------------------------------------
;;;    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。

MarcoW 发表于 2022-7-6 11:30:37

嗨,蒂姆,
 
我把它们都放在一个单独的lisp文件中并加载了它们,但它似乎不起作用。。
 
这是urn的命令,对吗?

(STDLIB_LOADLINETYPE "linetypename")


 
其中线型为“marcow”。
 
这是我得到的错误:


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

TimSpangler 发表于 2022-7-6 11:32:05

我的错,试试这个电话
 
(STDLIB_LOAD_线型“LINETYPE”)
 
忘记了额外的下划线。

MarcoW 发表于 2022-7-6 11:35:02

嗨,蒂姆,
 
我现在可以工作了,但我遇到了一个问题。也许你可以帮我。
 
我在我的代码中添加了你的代码,效果很好。我在一个支持路径中创建了一个自定义线型文件。
 
工作示例:
 

*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。林,我可以加载它,然后它也可以工作。
 
对不起,我解释得不好。。。

MarcoW 发表于 2022-7-6 11:39:00

哎呀。。。我的错。
 
我发现acadiso中已经有一种称为GAS的线型。lin文件。所以我猜这可能会有冲突:我把我的重命名为GAS2,它就解决了。
 
我想我马上就分享。

flowerrobot 发表于 2022-7-6 11:41:27

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

Lee Mac 发表于 2022-7-6 11:44:03

提姆,
 
这段代码是我通常用来将字符串分解为列表的代码。。。采用分隔符的字符串和字符代码(本例中为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)))

 
我只是觉得它可能比你拥有的要短。

Lee Mac 发表于 2022-7-6 11:49:44

提姆有点无聊,所以用另一种方式重新编写了你的例程
 

(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
查看完整版本: 需要代码帮助