Author Topic: HELP ME, Layer Create & Update  (Read 3358 times)

0 Members and 1 Guest are viewing this topic.

vnanhvu

  • Guest
HELP ME, Layer Create & Update
« on: June 08, 2011, 09:43:55 AM »
HI LEE
your lisp is good. can you develope it more? ex.: your lisp creat some layers, which have " EL_COMPONENTS" layer.... i sett it's lineweight 0.3... and Color 2... If my old draw existed layer " EL_COMPONENTS", your lisp not effect to " EL_COMPONENTS". Can you develop your lisp to fix this pro. When use your lisp, every layer change belong newlayer ( both color, lineweight....etc.. )
Thanks LEe again.
Code: [Select]
(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))
            )
          )
        )
      )
    )
  )
)


(defun c:norlays 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 return list detailing whether layer creation is successful.    
  (
    (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) "acad.lin"))
                )
              )
              (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  )
    )
  )
)
« Last Edit: June 08, 2011, 09:54:59 AM by CAB »

JohnK

  • Administrator
  • Seagull
  • Posts: 10638
Re: HELP ME, Layer Create & Update
« Reply #1 on: June 14, 2011, 09:02:08 AM »
Okay, I'll bite...

Is this what you're looking for?
Code: [Select]
(defun make-or-modify-layer (LNAM$ LCLR# LTYP$ LWGT# / #prog)
   ;;
   ;; Ex:
   ;; (make-or-modify-layer "Test-Layer" 1 "Continuous" 18)
   ;;  > create the layer
   ;; (make-or-modify-layer "Test-Layer" 1 "Continuous" 18)
   ;;  > would override the current layer def.
   ;;
   ;; By: John K
   ;;
  (if (null (tblsearch "layer" LNAM$))
    (set '#prog (lambda ( x ) (entmake x)))
    (set '#prog (lambda (x / ent y)
                  (setq ent (entget (tblobjname "LAYER" LNAM$)))
                  (foreach y x
                           (if (not (member (car y) '(0 100 2)))
                             (setq ent (subst y (assoc (car y) ent) ent))))
                  (entmod ent) )))
  (#prog
   (list
     (cons 0   "LAYER")
     (cons 100 "AcDbSymbolTableRecord")
     (cons 100 "AcDbLayerTableRecord")
     (cons 2    LNAM$)
     (cons 6    LTYP$)
     (cons 62   LCLR#)
     (cons 70   0)
     (cons 290  1)
     (cons 370  LWGT#)
     )
   )
 (princ)
 )
TheSwamp.org (serving the CAD community since 2003)
Member location map - Add yourself

Donate to TheSwamp.org

vnanhvu

  • Guest
Re: HELP ME, Layer Create & Update
« Reply #2 on: June 14, 2011, 01:58:13 PM »
where i can inser your code into Lee's code?
Thank you so much.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: HELP ME, Layer Create & Update
« Reply #3 on: June 14, 2011, 03:22:46 PM »
Okay, I'll bite...

I think you got bit.  :evil:
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

JohnK

  • Administrator
  • Seagull
  • Posts: 10638
Re: HELP ME, Layer Create & Update
« Reply #4 on: June 14, 2011, 03:25:35 PM »
where i can inser your code into Lee's code?
Thank you so much.

In the part that you want to fix?


Please Note:
I didnt look at Lee's code.
  •    I dont care what Lee's code does (how it works); i was trying to help YOU--not Lee-.
I am not going to modify Lee's code.
  •    That is up to you; I can already program myself so i dont need to learn "how to fix his code" (or what ever it is you are trying to do).
  •    There are Copyrights on that code; he obvously wants to retain that code as-is so if there is a problem with it, he needs to fix it. I am not trying to start a battle over ownership (I dont try to "own" code or "take" ownership).
I just wanted to help
  •    If what i provided doesnt work, then i appologize.
TheSwamp.org (serving the CAD community since 2003)
Member location map - Add yourself

Donate to TheSwamp.org

JohnK

  • Administrator
  • Seagull
  • Posts: 10638
Re: HELP ME, Layer Create & Update
« Reply #5 on: June 14, 2011, 03:29:16 PM »
Okay, I'll bite...

I think you got bit.  :evil:

yeah, but i dont partake in that whole `forum-face' thing so i can just walk away; If the OP doesnt want help...i dont care.
TheSwamp.org (serving the CAD community since 2003)
Member location map - Add yourself

Donate to TheSwamp.org

alanjt

  • Needs a day job
  • Posts: 5352
  • Standby for witty remark...
Re: HELP ME, Layer Create & Update
« Reply #6 on: June 14, 2011, 03:35:53 PM »
What's 'forum-face'?
Civil 3D 2019 ~ Windohz 7 64bit
Dropbox

JohnK

  • Administrator
  • Seagull
  • Posts: 10638
Re: HELP ME, Layer Create & Update
« Reply #7 on: June 14, 2011, 03:40:37 PM »
What's 'forum-face'?
I'm not looking for fame and fortune. I'm more academic by nature where people or things being wrong isn't a bad thing (actually, being wrong is more of a good thing because it fuels the fire so-to-speak) for example.
TheSwamp.org (serving the CAD community since 2003)
Member location map - Add yourself

Donate to TheSwamp.org

alanjt

  • Needs a day job
  • Posts: 5352
  • Standby for witty remark...
Re: HELP ME, Layer Create & Update
« Reply #8 on: June 14, 2011, 03:42:53 PM »
What's 'forum-face'?
I'm not looking for fame and fortune. I'm more academic by nature where people or things being wrong isn't a bad thing (actually, being wrong is more of a good thing because it fuels the fire so-to-speak) for example.
Right on. I can get behind that.
Civil 3D 2019 ~ Windohz 7 64bit
Dropbox

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: HELP ME, Layer Create & Update
« Reply #9 on: June 14, 2011, 05:15:48 PM »
Use at your own risk.
Very little testing.

Code: [Select]
;;  Modified by CAB , apologies to Lee for the hack.
;;  Make or Modify a layer
(defun MakeLayer ( name colour linetype lineweight willplot bitflag description / ent elst layer)
  ;; © Lee Mac 2010
  ;;  06/14/2011 CAB added ability to modify existing layer data
  (if (setq ent (tblobjname "LAYER" name))
    (progn
      (setq elst (entget ent)
            elst (subst (cons 6 (if (and linetype (tblsearch "LTYPE" linetype))
                                       linetype "CONTINUOUS")) (assoc 70 elst) elst)
            elst (if (assoc 62 elst)
                   (subst (cons 62 (if (and colour (< 0 (abs colour) 256)) colour 7)) (assoc 62 elst) elst)
                   (append elst (list (cons 62 (if (and colour (< 0 (abs colour) 256)) colour 7))))
                 )
            elst (if (assoc 70 elst) (subst (cons 70 bitflag) (assoc 70 elst) elst)
                   (append elst (list (cons 70 bitflag))))
            elst (subst (cons 290 (if willplot 1 0)) (assoc 290 elst) elst)
            elst (subst (cons 370
                          (if (minusp lineweight) -3
                            (fix
                              (* 100
                                 (if (and lineweight (<= 0.0 lineweight 2.11)) lineweight 0.0)
                              )
                             )
                          )
                        )
                     (assoc 370 elst) elst)
      )
      (entmod elst)
      (if (and description (setq layer (vlax-ename->vla-object ent)))
            (if (vlax-property-available-p layer 'Description)
              (vla-put-Description layer description)
            )
      )
    )
    (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))
            )
          )
        )
      )
    )
  ) ; endif
)
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

GDF

  • Water Moccasin
  • Posts: 2081
Re: HELP ME, Layer Create & Update
« Reply #10 on: June 14, 2011, 06:10:42 PM »
Use at your own risk.
Very little testing.


Very nice Alan. I learned a lot from your hack.

 :kewl:
Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2020x64 Windows 10x64

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: HELP ME, Layer Create & Update
« Reply #11 on: June 14, 2011, 07:23:46 PM »
Well thanks Gary. 8-)
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

vnanhvu

  • Guest
Re: HELP ME, Layer Create & Update
« Reply #12 on: June 14, 2011, 09:15:43 PM »
The first i thank for all.
I'm not good with LSP. I learn more when i become theswarnp member. And my English not good. What if i dont understand, I hope people are willing and happy comments and help.
Thanks again.