本帖最后由 sachindkini 于 2022-10-3 23:09 编辑
- (defun c:MakeLayers 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
- ( "EL_COMPONENTS" 7 "CONTINUOUS" -3 T 0 nil )
- ( "EL_CONSTR_COMP" 1 "CONTINUOUS" -3 T 0 nil )
- ( "EL_FITTINGS" 4 "CONTINUOUS" -3 T 0 nil )
- ( "EL_LABEL" 1 "CONTINUOUS" -3 T 0 nil )
- ( "EL_LABEL_TXT" 252 "CONTINUOUS" -3 T 0 nil )
- ( "EL_TERMINALS" 1 "CONTINUOUS" -3 T 0 nil )
- ( "EL_TERMINALS_PE" 24 "CONTINUOUS" -3 T 0 nil )
- ( "EL_TERMINALS_TXT" 252 "CONTINUOUS" -3 T 0 nil )
- ( "EL_TXT" 252 "CONTINUOUS" -3 T 0 nil )
- ( "EL_WIRES" 252 "CONTINUOUS" -3 T 0 nil )
- ( "GE_ANNOTATION" 7 "CONTINUOUS" -3 T 0 nil )
- ( "GE_LABEL" 10 "CONTINUOUS" -3 T 0 nil )
- ( "GE_LABEL_TEXT" 253 "CONTINUOUS" -3 T 0 nil )
- ( "GE_TXT_LANGUAGE_DU" 252 "CONTINUOUS" -3 T 0 nil )
- ( "GE_TXT_LANGUAGE_EN" 252 "CONTINUOUS" -3 T 0 nil )
- ( "GE_TXT_LANGUAGE_FR" 252 "CONTINUOUS" -3 T 0 nil )
- ( "GE_TXT_LANGUAGE_GE" 252 "CONTINUOUS" -3 T 0 nil )
- ( "LA_HEADER_FRAME" 7 "CONTINUOUS" -3 T 0 nil )
- ( "LA_HEADER_TXT" 7 "CONTINUOUS" -3 T 0 nil )
- ( "LA_MATLIST" 254 "CONTINUOUS" -3 T 0 nil )
- ( "LA_MATLIST_FRAME" 254 "CONTINUOUS" -3 T 0 nil )
- ( "LA_MATLIST_POS" 254 "CONTINUOUS" -3 T 0 nil )
- ( "LA_MATLIST_TXT" 252 "CONTINUOUS" -3 T 0 nil )
- ( "LA_TITLE_FRAME" 7 "CONTINUOUS" -3 T 0 nil )
- ( "LA_TITLE_LOGO" 10 "CONTINUOUS" -3 T 0 nil )
- ( "LA_TITLE_LOGO_TXT" 7 "CONTINUOUS" -3 T 0 nil )
- ( "LA_TITLE_TXT" 7 "CONTINUOUS" -3 T 0 nil )
- ( "LA_VIEWPORTS" 230 "CONTINUOUS" -3 nil 0 nil )
- ( "PN_ACCESSORIES" 30 "CONTINUOUS" -3 T 0 nil )
- ( "PN_ACTUATORS" 160 "CONTINUOUS" -3 T 0 nil )
- ( "PN_AIR_LINE_EQUIPMENT" 40 "CONTINUOUS" -3 T 0 nil )
- ( "PN_BRACKET_MOUNTING" 1 "ACAD_ISO12W100" -3 T 0 nil )
- ( "PN_CABINET" 8 "CONTINUOUS" -3 T 0 nil )
- ( "PN_CABINET_DIM" 8 "CONTINUOUS" -3 T 0 nil )
- ( "PN_COMPONENTS" 7 "CONTINUOUS" -3 T 0 nil )
- ( "PN_CONDUCTS" 3 "CONTINUOUS" -3 T 0 nil )
- ( "PN_CONSTR_COMP" 2 "CONTINUOUS" -3 T 0 nil )
- ( "PN_DRAIN" 3 "HIDDEN" -3 T 0 nil )
- ( "PN_EXHAUST" 104 "CONTINUOUS" -3 T 0 nil )
- ( "PN_FITTINGS" 30 "CONTINUOUS" -3 T 0 nil )
- ( "PN_IDENTIFICATION" 4 "CONTINUOUS" -3 T 0 nil )
- ( "PN_PILOT_SUPPLY" 3 "HIDDEN" -3 T 0 nil )
- ( "PN_PORT_NUMBERS" 8 "CONTINUOUS" -3 T 0 nil )
- ( "PN_PRESSURE_SWITCHES" 200 "CONTINUOUS" -3 T 0 nil )
- ( "PN_PROPORTIONAL_VALVES" 226 "CONTINUOUS" -3 T 0 nil )
- ( "PN_SECTIONS" 3 "CONTINUOUS" -3 T 0 nil )
- ( "PN_SUB-BASES" 8 "ACAD_ISO12W100" -3 T 0 nil )
- ( "PN_SUB-BASE_CONDUCTS" 2 "CONTINUOUS" -3 T 0 nil )
- ( "PN_SUPPLY" 3 "CONTINUOUS" -3 T 0 nil )
- ( "PN_TXT" 3 "CONTINUOUS" -3 T 0 nil )
- ( "PN_VACUUM" 60 "CONTINUOUS" -3 T 0 nil )
- ( "PN_VALVES" 240 "CONTINUOUS" -3 T 0 nil )
- ( "PN_VALVES_OVERRIDE" 1 "CONTINUOUS" -3 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 - 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)
- )
- )
| 
发表于 2022-7-26 17:38:53
UB_WINDW" "c" "7" "" "")
显身卡
楼主
好，谢谢