[编程交流] Lisp文件组织

(defun c:LPS ()
 ;; (load "programming_tools.fas")
 ;; ... Code for personal settings
 ;; (load "production_tools.fas")
 (princ))

(if (= 1 (getvar 'dwgtitled))      ; If drawing is named,
 (c:LPS))                         ; Then load personal settings.
(princ)

;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;
   ;;2010.11.04  Layer Setup by Christopher T. Cowgill                                    ;;
   ;;Truecolor function by Fred Tomke (www.theswamp.org)                                ;;
   ;;Coding assistance provided by Opie, RobertB, and irneb (www.augi.com), ronjonp    ;;
   ;;Original code simplification by alanjt (www.augi.com, www.theswamp.org)            ;;
   ;;CTRL+G to goto Line)                                                                ;;
   ;;c:Pavtmrkglayerstate LAY-PavtMrkg                                                    ;;
   ;;c:createsanitaryprofilelayers LAY-Profiles                                        ;;
   ;;c:createstormprofilelayers LAY-Profiles                                            ;;
   ;;c:profilebaselayers LAY-Profiles                                                    ;;
   ;;c:PNPBaseLayerstate LAY-PNPBase                                                    ;;
   ;;c:SCDLayerstate LAY-SurveyControlData                                                ;;
   ;;c:PNPMSLayerstate LAY-PNPInP                                                        ;;
   ;;c:roadbaselayers LAY-RoadBase                                                        ;;
   ;;c:surveybaselayers LAY-SurveyBase                                                    ;;
   ;;c:tinlayerstate LAY-Tin                                                            ;;
   ;;c:PnPFinalLayerState LAY-PNPFinal-Create                                            ;;
   ;;c:CreatePnPLayers LAY-PNPFinal-Create                                                ;;
   ;;c:logLayerState LAY-Log-Overall                                                    ;;
   ;;c:overallsiteplan LAY-Log-Overall                                                    ;;
   ;;c:createpresentationlayers LAY-Presentation                                        ;;
   ;;c:CreateXsectionLayers LAY-XSection                                                ;;
   ;;c:intersectionlayerstate LAY-InterSection                                            ;;
   ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;
   ;;****************************************************************************************************************************************
   (defun truecolor (uColor / oColor)
     (setq oColor (vla-getinterfaceobject acadObject "AutoCAD.AcCmColor.18"))
     (cond
   ((= (type uColor) 'INT)
    (vla-put-ColorMethod oColor acColorMethodByACI)
    (vla-put-ColorIndex oColor uColor)
   )
   ((not (listp uColor)) nil)
   ((= (length uColor) 3)
    (vla-put-ColorMethod oColor acColorMethodByRGB)
    (vla-SetRGB oColor (car uColor) (cadr uColor) (last uColor))
   )
   ((= (length uColor) 2)
    (vla-SetColorBookColor oColor (car uColor) (cadr uColor))
   )
     ) ; cond
     ocolor
   ) ; truecolor
   ;;****************************************************************************************************************************************
   (defun alllayerset (lst / listlayer name match)
     (command "linetype" "_load" "*" "acad" "")
     (command "-layer" "SET" "0" "")
     (setq listlayer (vla-get-layers acaddocument))
     (foreach y lst
   (if (wcmatch (car y) "*`**")
     ()
     (if (tblsearch "LAYER" (car y))
       ()
       (vla-add listlayer (car y))
     ) ;_ end of if
   ) ;_ end of if
     ) ;_ end of foreach
     (vlax-for    x listlayer
   (or (vl-position (setq name (strcase (vla-get-name x))) '("0" "DEFPOINTS"))
       (if    (setq match (vl-remove-if-not
                 (function (lambda (x) (wcmatch name (strcase (car x)))))
                 lst
               ) ;_ end of vl-remove-if-not
       ) ;_ end of setq
         (mapcar (function
           (lambda    (p v)
             (if v
               (vl-catch-all-apply
                 (function vlax-put-property)
                 (list x p v)
               ) ;_ end of vl-catch-all-apply
             ) ;_ end of if
           ) ;_ end of lambda
             ) ;_ end of function
             '(Freeze Color LineType Plottable Description Truecolor)
             (cdar match)
         ) ;_ end of mapcar
       ) ;_ end of if
   ) ;_ end of or
     ) ;_ end of vlax-for
     (setq name nil)
     (vla-regen acadDocument acAllViewports)
   ) ;_ end of defun

(defun c:overallsiteplan (/ layerlist layerlist1 layerlist2)
     (setq layerlist
        '(
          ("*|*" :vlax-true)
         )
     ) ;_ end of setq
     (setq layerlist1
        '(
          ("*Prop Sanitary*" :vlax-false)
          ("*Prop Forcemain*" :vlax-false)
          ("*Prop Water*" :vlax-false)
          ("*|Property" :vlax-false 
          ("*|ROW" :vlax-false 
          ("Dim" :vlax-false 3)
          ("Text" :vlax-false 3)
          ("*Exist EP*" :vlax-true)
          ("*Prop EP*" :vlax-true)
         )
     ) ;_ end of setq
     (alllayerset layerlist)
     (alllayerset layerlist1)
   ) ;_ end of defun
(defun c:createpresentationlayers (/ layerlist acm)
     (setq layerlist
        (list
          (list "Hatch Water" :vlax-false nil nil nil nil (truecolor (list 0 174 255)))
          (list "Hatch Trees" :vlax-false nil nil nil nil (truecolor (list 127 255 0)))
          (list "Hatch Concrete" :vlax-false nil nil nil nil (truecolor (list 200 200 200)))
          (list "Hatch Grass" :vlax-false nil nil nil nil (truecolor (list 80 193 36)))
          (list "Hatch HMA" :vlax-false nil nil nil nil (truecolor (list 100 100 100)))
          (list "Hatch Gravel" :vlax-false nil nil nil nil (truecolor (list 174 100 0)))
          (list "Sign Yellow"
            :vlax-false
            nil
            nil
            nil
            nil
            (truecolor (list "PANTONE(R) color bridge CMYK EC" "PANTONE 116 EC"))
          ) ;_ end of list
          (list "Sign Blue"
            :vlax-false
            nil
            nil
            nil
            nil
            (truecolor (list "PANTONE(R) color bridge CMYK EC" "PANTONE 294 EC"))
          ) ;_ end of list
          (list "Sign Orange"
            :vlax-false
            nil
            nil
            nil
            nil
            (truecolor (list "PANTONE(R) color bridge CMYK EC" "PANTONE 152 EC"))
          ) ;_ end of list
          (list "Sign Red"
            :vlax-false
            nil
            nil
            nil
            nil
            (truecolor (list "PANTONE(R) color bridge CMYK EC" "PANTONE 187 EC"))
          ) ;_ end of list
          (list "Sign Green"
            :vlax-false
            nil
            nil
            nil
            nil
            (truecolor (list "PANTONE(R) color bridge CMYK EC" "PANTONE 342 EC"))
          ) ;_ end of list
          (list "Sign Brown"
            :vlax-false
            nil
            nil
            nil
            nil
            (truecolor (list "PANTONE(R) color bridge CMYK EC" "PANTONE 469 EC"))
          ) ;_ end of list
          (list "Sign Flourecent" :vlax-false nil nil nil nil (truecolor (list 175 255 0)))
          (list "Sign Purple"
            :vlax-false
            nil
            nil
            nil
            nil
            (truecolor (list "PANTONE(R) color bridge CMYK EC" "PANTONE 259 EC"))
          ) ;_ end of list
        ) ;_ end of list
     ) ;_ end of setq
     (alllayerset layerlist)
   ) ;_ end of defun