[编程交流] 将lsp转换为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? Bitflag  Description 
   ( "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 2  name)
         (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 - [url]www.lee-mac.com[/url]       ;;
;;------------------------------------------------------------;;
;;  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 - [url]www.lee-mac.com[/url]       ;;
;;------------------------------------------------------------;;
;;  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
       )
     )
   )