将lsp转换为vlx时出错
为什么我不能将LEEMAC的LISP LAYERMAKER转换为VLX！代码：
(defun c:1000 nil (vl-load-com)
;; © Lee Mac 2010
;;----------------------------------------------------------------------------------------------;;
;; Specifications: ;;
;;----------------------------------------------------------------------------------------------;;
;; Description Data Type Remarks ;;
;;----------------------------------------------------------------------------------------------;;
;; Layer Name STRING Only standard chars allowed. ;;
;; Layer Colour INTEGER may be nil, -ve for Layer Off, Colour < 256 ;;
;; Layer Linetype STRING may be nil, If not loaded, CONTINUOUS. ;;
;; Layer Lineweight REAL may be nil, negative=Default, otherwise 0 <= x <= 2.11 ;;
;; Plot? BOOLEAN T = Plot Layer, nil otherwise ;;
;; Bit Flag INTEGER 0=None, 1=Frozen, 2=Frozen in VP, 4=Locked ;;
;; Description STRING may be nil for no description ;;
;;----------------------------------------------------------------------------------------------;;
;; Function will print list detailing any unsuccesful layers ;;
;;----------------------------------------------------------------------------------------------;;
(
(lambda ( lst )
(mapcar 'print
(vl-remove-if 'cdr
(mapcar
(function
(lambda ( x )
(and (caddr x) (LM:LoadLinetype (caddr x))) (cons (car x) (apply 'MakeLayer x))
)
)
lst
)
)
)
)
'(
;Name Colour Linetype Lineweight Plot? BitflagDescription
( "COT" 2"CONTINUOUS" 0.4 T 0 nil)
( "CUA" 151"CONTINUOUS" 0.13 T 0 nil)
( "CUA2" 157"CONTINUOUS" 0.13 T 0 nil)
( "DIEN" 30"CONTINUOUS" 0.3 T 0 nil)
( "DUONGDIEN" 227"ÑIEÄN" 0.13 T 0 nil)
( "DUONGNUOC" 38"NÖÔÙC" 0.13 T 0 nil)
( "DUONGRANHGIOI" 16"NÖÔÙC" 0.13 T 0 nil)
( "DUONGNUOC" 227"NÖÔÙC" 0.13 T 0 nil)
( "GACH" 69"CONTINUOUS" 0.09 T 0 nil)
( "GACH2" 73"CONTINUOUS" 0.09 T 0 nil)
( "GHICHU" 16"CONTINUOUS" 0.13 T 0 nil)
( "HATCH" 177 "CONTINUOUS" 0.09 T 0 nil)
( "HTUONG" 26"CONTINUOUS" 0.09 T 0 nil)
( "KHONGIN" 2"CONTINUOUS" 0.13 nil 0 nil)
( "KICHTHUOC" 206"CONTINUOUS" 0.09 T 0 nil)
( "KYHIEU" 146"CONTINUOUS" 0.13 T 0 nil)
( "KYHIEU2" 145"CONTINUOUS" 0.13 T 0 nil)
( "MAI" 45"CONTINUOUS" 0.13 T 0 nil)
( "NETCAT" 7"CONTINUOUS" 0.4 T 0 nil)
( "NETCAT2" 253"CONTINUOUS" 0.3 T 0 nil)
( "NETKHUAT" 252"HIDDEN" 0.09 T 0 nil)
( "NETTHAY" 67"CONTINUOUS" 0.18 T 0 nil)
( "NETVIEN" 44"CONTINUOUS" 0.3 T 0 nil)
( "NUOC" 150"CONTINUOUS" 0.13 T 0 nil)
( "NUOCMUA" 53"NUOCMUA2" 0.13 T 0 nil)
( "NUOCTHAI" 35"NUOCTHAI3" 0.13 T 0 nil)
( "SOTRUC" 9"CONTINUOUS" 0.13 T 0 nil)
( "TBWC" 23"CONTINUOUS" 0.13 T 0 nil)
( "TRUC" 251"DASHDOT" 0.09 T 0 nil)
( "VATDUNG" 25"CONTINUOUS" 0.09 T 0 nil)
( "VATDUNG2" 21"CONTINUOUS" 0.09 T 0 nil)
( "VUWIP" 210"." 0.09 T 0 nil)
( "XREF" 137"CONTINUOUS" 0.09 T 0 nil)
)
)
(princ)
)
(defun MakeLayer ( name colour linetype lineweight willplot bitflag description )
;; © Lee Mac 2010
(or (tblsearch "LAYER" name)
(entmake
(append
(list
(cons 0 "LAYER")
(cons 100 "AcDbSymbolTableRecord")
(cons 100 "AcDbLayerTableRecord")
(cons 2name)
(cons 70 bitflag)
(cons 290 (if willplot 1 0))
(cons 6
(if (and linetype (tblsearch "LTYPE" linetype))
linetype "CONTINUOUS"
)
)
(cons 62 (if (and colour (< 0 (abs colour) 256)) colour 7))
(cons 370
(if (minusp lineweight) -3
(fix
(* 100
(if (and lineweight (<= 0.0 lineweight 2.11)) lineweight 0.0)
)
)
)
)
)
(if description
(list
(list -3
(list "AcAecLayerStandard" (cons 1000 "") (cons 1000 description))
)
)
)
)
)
)
)
;;--------------------=={ Load Linetype }==-------------------;;
;; ;;
;;Attempts to load a specified linetype from any linetype ;;
;;definition files (.lin) found in the ACAD Support Path ;;
;;------------------------------------------------------------;;
;;Author: Lee Mac, Copyright © 2011 - www.lee-mac.com ;;
;;------------------------------------------------------------;;
;;Arguments: ;;
;;lt - name of linetype to load ;;
;;------------------------------------------------------------;;
;;Returns:T if linetype loaded successfully, else nil ;;
;;------------------------------------------------------------;;
(defun LM:LoadLinetype ( lt ) (vl-load-com)
;; © Lee Mac 2010
(cond
( (tblsearch "LTYPE" lt) )
( (progn
(or acdoc (setq acdoc (vla-get-ActiveDocument (setq acapp (vlax-get-acad-object)))))
(or aclts (setq aclts (vla-get-Linetypes acdoc)))
(vl-some
(function
(lambda ( file )
(vl-catch-all-apply 'vla-load (list aclts lt file))
(and (tblsearch "LTYPE" lt))
)
)
(setq *LineTypeDefs*
(cond
( *LineTypeDefs* )
(
(apply 'append
(mapcar '(lambda ( directory ) (vl-directory-files directory "*.lin" 1))
(LM:str->lst
(vla-get-SupportPath (vla-get-Files (vla-get-Preferences acapp))) ";"
)
)
)
)
)
)
)
)
)
)
)
;;-------------------=={ String to List }==-------------------;;
;; ;;
;;Separates a string into a list of strings using a ;;
;;specified delimiter string ;;
;;------------------------------------------------------------;;
;;Author: Lee Mac, Copyright © 2011 - www.lee-mac.com ;;
;;------------------------------------------------------------;;
;;Arguments: ;;
;;str - string to process ;;
;;del - delimiter by which to separate the string ;;
;;------------------------------------------------------------;;
;;Returns:A list of strings ;;
;;------------------------------------------------------------;;
(defun LM:str->lst ( str del / pos )
;; © Lee Mac 2010
(if (setq pos (vl-string-search del str))
(vl-remove "" (cons (substr str 1 pos) (LM:str->lst (substr str (+ pos 1 (strlen del))) del)))
(list str)
)
)
(
(lambda ( lst / lts ) (setq lts (vla-get-Linetypes (vla-get-ActiveDocument (vlax-get-acad-object))))
(mapcar 'cons (mapcar 'car lst)
(mapcar
(function
(lambda ( x )
(and (caddr x)
(or (tblsearch "LTYPE" (caddr x))
(vl-catch-all-apply 'vla-load (list lts (caddr x) "acadiso.lin"))
)
)
(apply 'MakeLayer x)
)
)
lst
)
)
)
代码末尾缺少右括号。
我认为他的许可是可以的。请参阅：http://lee-mac.com/terms.html 感谢rkmcswain的澄清。 vnanhvu，
您为什么复制此部分：
到代码末尾？
此外，我很好奇为什么您希望将此代码编译为VLX？ ：吃爆米花：：注意：
既然！这就是问题所在。
宝贝，你害怕吗？ 有什么大不了的？
我原本想跳到礼来池并发布那个片段，但我不想假设我得到了允许。
另外，我问马克是否有一个小的用户文件夹，但没有回应（或文件夹）。
没什么大不了的。。。我只是怀疑你前面的两个问题会引起一些有趣的反应（就像过去一样）。
我不想出轨，李~房间里全是男孩子。
页:
[1]
2