Topic: LISP to filter by Layer & Colour?

[Craig Davis]

We currently have access to AutoCAD drawings which contains property information that we can use for designs. This consists of lines, polylines and text.

The problem is that the various pices of information are in numeric layers and different colours.

I want to be able to sort the data using a LISP program to minimise the repetitive work.

I did a VLISP program a while ago with the help of posters here which did a similar thing however it only sorted via a Layer. I want to do similar but be able to sort by both Layer & Colour.

Is there an easy edit to the following code or does it need a lot more work. I'm not too bad with LISP but not that good with VLISP.

Code: [Select]

(defun ssget->vla-list (selection-set / index vla-list)
  (setq index (if selection-set
(1-
  (sslength selection-set)
)
-1
      )
  )
  (while (>= index 0)
    (setq vla-list
   (cons
     (vlax-ename->vla-object
       (ssname selection-set index)
     )
     vla-list
   )
  index    (1- index)
    )
  )
  vla-list
)

(defun MakeLay (Name)
  (vl-catch-all-apply
    'vlax-put-property
    (list
      (vla-get-ActiveDocument
(vlax-get-acad-object)
      )
      'ActiveLayer
      (vlax-invoke-method
(vla-get-layers
  (vla-get-ActiveDocument
    (vlax-get-acad-object)
  )
)
'Add
Name
      )
    )
  )
)

(defun c:PLACESDXF ()
  (vl-load-com)
  (setq thisdrawing
(vla-get-activedocument
   (vlax-get-acad-object)
)
  )
  (setq mspace (vla-get-modelspace thisdrawing))
  ;;creating arrays
  (setq layer_list_s
(vlax-make-safearray vlax-vbString '(0 . 1) '(1 . 24))
  ) ;create array sewer points
  (vlax-safearray-fill
    layer_list_s
    '(("swair"   "swcod"    "swcss" "swdcn"    "swdm"
       "swdwj"   "swelj"    "sweol" "swgcm"    "swio"
       "swjnt"   "swmat"    "swmdm" "swnrv"    "swoxy"
       "swpst"   "swsft"    "swstdm" "swsv"    "swtms"
       "swupj"   "swevt"    "swivt" "swmvt"
      )
      ("Air valve" "Change of grade"
       "Core sample site" "Decom sewer"
       "Drop manhole" "Downstream access shaft"
       "EOL access shaft" "End of line"
       "Gas check manhole" "Inspection opening"
       "Junction" "Maintenance shaft"
       "Multi drop manhole" "Non return valve"
       "Oxygen injection" "Pump station"
       "Maintenance shaft" "Standard manhole"
       "Stop valve" "Terminal maintenance"
       "Upstream access shaft" "Sewer vent"
       "Sewer vent" "Sewer vent"
      )
     )
  ) ;assign array values
  (setq layer_list_w
(vlax-make-safearray vlax-vbString '(0 . 1) '(1 . 26))
  ) ;create array water points
  (vlax-safearray-fill
    layer_list_w
    '(("wetair"    "wetcss"    "wetdcn"    "wetdlg"    "wetdls"
       "wetdos"    "weteol"    "wetfp"    "wetio"     "wetjnt"
       "wetmat"    "wetmet"    "wetnar"    "wetnrv"    "wetph"
       "wetps"    "wetrec"    "wetred"    "wetrss"    "wetsco"
       "wetser"    "wetstd"    "wetsv"    "wetswb"    "wetval"
       "wetzv"
      )
      ("Air valve"    "Cross"        "Decom water"
       "Cross"    "Cross"        "Dosing station"
       "Dead end cap"    "Fire plug"        "Inspection opening"
       "Pipe junction"    "Material change"   "Meter"
       "Non return valve"  "Non return valve"  "Pillar hydrant"
       "Pump station"    "Recorder"        "Reducer"
       "Cross"    "Scour"        "Service valve"
       "Stand pipe"    "Stop valve"        "Swabbing point"
       "Valve"    "Zone valve"
      )
     )
  ) ;assign array values
  (setq layer_list
(vlax-make-safearray vlax-vbString '(0 . 1) '(1 . 22))
  ) ;create array water & sewer mains
  (vlax-safearray-fill
    layer_list
    '(("swo*"    "weto*"     "sw000"    "sw100"     "sw150"
       "sw225"    "sw300"     "sw375"    "sw600"     "sw825"
       "swbig"    "wet000"    "wet100"    "wet150"    "wet225"
       "wet300"    "wet375"    "wet600"    "wet825"    "wetbig"
       "swdcp"    "wetdcp"
      )
      ("PLACES.sew_os_txt"   "PLACES.wat_os_txt"
       "Places_sew_mains"   "Places_sew_mains"
       "Places_sew_mains"   "Places_sew_mains"
       "Places_sew_mains"   "Places_sew_mains"
       "Places_sew_mains"   "Places_sew_mains"
       "Places_sew_mains"   "Places_wat_mains"
       "Places_wat_mains"   "Places_wat_mains"
       "Places_wat_mains"   "Places_wat_mains"
       "Places_wat_mains"   "Places_wat_mains"
       "Places_wat_mains"   "Places_wat_mains"
       "Places_sew_decom"   "Places_wat_decom"
      )
     )
  ) ;assign array values
;;setting all objects to bylayer
  (cond
    ((setq ssall (ssget "x")) ; get all entities
     (setq count 0)
     (repeat (sslength ssall)
       (setq obj (vlax-ename->vla-object (ssname ssall count)))
       (vlax-put-property obj "Color" 256)
       (vlax-put-property obj "Linetype" "ByLayer")
       (vlax-put-property obj "Lineweight" acLnWtByLwDefault)
       (vlax-release-object obj)
       (setq count (1+ count))
     )
    )
  )
  (princ "\nFinished processing all entities to ByLayer.")
  (princ)
  ;;inserting sewer symbols
  (setq ss1 (ssget->vla-list (ssget "x" '((0 . "POINT")))))
  (MakeLay "PLACES.symbol_sewer")
;Convert all points into a vla-object list
  (setq test1 0)
  (foreach item ss1 ;foreach will iterate through all point objects in above list
    (setq pt (vla-get-coordinates item)
;equiv to (cdr (assoc 10 el)) except it's a variant
  lyr (vla-get-layer item) ;equiv to (cdr (assoc 8 el))
  count 0
  test1 (+ test1 1)
    )
    (setq test1a 0)
    (setq T1 1)
    (while T1
      (setq test1a (+ test1a 1))
      (setq count (+ count 1)) ;sets number for first array
      (setq lyrlst (vlax-safearray-get-element layer_list_s 0 count))
      (if (= lyrlst lyr) ;check if layer_list_s matches point layer
(progn
  (vla-InsertBlock
    mspace
    pt
    (vlax-safearray-get-element layer_list_s 1 count)
    "1"
    "1"
    "1"
    "0"
  )
  (vla-delete item)
  (setq t1 nil)
) ;progn
      ) ;if
      (if (= count 24) ;else
(setq T1 nil)
      )
    ) ;while
  ) ;foreach
    ;;inserting water symbols
  (setq ss1 (ssget->vla-list (ssget "x" '((0 . "POINT")))))
  (MakeLay "PLACES.symbol_water")
  (setq test2 0)
  (foreach item ss1 ;foreach will iterate through all point objects in above list
    (setq pt (vla-get-coordinates item)
;equiv to (cdr (assoc 10 el)) except it's a variant
  lyr (vla-get-layer item) ;equiv to (cdr (assoc 8 el))
  count 0
  test2 (+ test2 1)
    )
    (setq test2a 0)
    (setq T1 1)
    (while T1
      (setq test2a (+ test2a 1))
      (setq count (+ count 1))
;sets number for first array
      (setq lyrlst (vlax-safearray-get-element layer_list_w 0 count))
      (if (= lyrlst lyr) ;check if layer_list_w matches point layer
(progn
  (vla-InsertBlock
    mspace
    pt
    (vlax-safearray-get-element layer_list_w 1 count)
    "1"
    "1"
    "1"
    "0"
  )
  (vla-delete item)
  (setq t1 nil)
) ;progn
      ) ;if
      (if (= count 26) ;else
(setq T1 nil)
      )
    )
;while
  ) ;foreach
  ;;changing layer names
  (setq count 1)
  (repeat 22
    (setq lyrname (vlax-safearray-get-element layer_list 0 count))
    (setq lyrnew (vlax-safearray-get-element layer_list 1 count))
    (setq ss1 (ssget->vla-list (ssget "x" (list (cons 8 lyrname)))))
    (foreach item ss1
      (vlax-put-property item "Layer" lyrnew)
    ) ;foreach
    (setq count (+ count 1))
  )
  (if (= lyrlst lyr)
    (PRINC "\nAll points processed.")
    (alert "WARNING. Points present not in layer list.")
  )
)
Any suggestions or help would be appreciated.

Regards

Craig

[CAB]

Craig,
I don't see any sort going on in this code. Perhaps the layers are already in order.
Could you explain in more detail what you want to do?

Do you just want to create a list of objects sorted by layer + color?

[CAB]

Perhaps this will get you closer to your goal:

Code: [Select]

(defun c:test (/ lst objlst)
  (prompt "\nSelect items to sort.")
  (setq ss (ssget))
  ;;  create a list of objects
  (setq objlst (mapcar 'vlax-ename->vla-object
                       (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
  ;;  add to the list the layer & color
  (setq objlst (mapcar
                 '(lambda (x) (list x (vla-get-layer x) (vla-get-color x)))
                   objlst))
  ;;  sort the list on layer plus color
  (setq sortlist (vl-sort objlst
                    '(lambda (e1 e2)
                       (if (= (cadr e1) (cadr e2))
                         (< (caddr e1) (caddr e2))
                         (< (cadr e1) (cadr e2))
                       )
                     )))
  [color=red](mapcar 'print sortlist)[/color]
  (princ)
)<edit: print output added>

[Craig Davis]

CAB sorry I wasn't very clear with my explanation.

What the current code does is sorts through the entities and modifies the objects from certain layers onto a layer created by the LISP program. This was to simplify and clean up the original data as well as insert the correct symbols for sewer manholes and fire plugs etc. on the correct points (which were in various layers). This data was from the GIS system where I worked and was mainly controlled by the layer.

Where I work now we have access to a different set of data and this is controlled by a combination of layers and colours.

I would like to have the LISP run through the entities and grab any entities with say layer "2" & colour "55" and modify that to a layer "CAD_Property-line" with both colour & linetype "bylayer" the next one would be to get layer "2" & colour "33" and modify that to layer "CAD_Road-boundary" etc.

I hope that's a bit clearer. I've been using filters within Civil3D to do it but of course this is getting very old very quickly from project to project.

Is that what your code above is doing? With my untrained eye to VLISP it looks like it could be doing that.

Thanks for the replies.

[CAB]

The code I posted simply sorts the entities by layer & color.

I have a better idea what your are after now. If I remember correctly Tim Willey has a layer merge lisp that may work for this. Otherwise I or someone else will look at your request tomorrow.

ZZzzzzzzz   

[Craig Davis]

Thanks for that.

If I can work out how to filter the entities by the combined layer and colour I might be able to get it to where I want it.

[CAB]

I added a print output to my code example. This is what the sorted list looks like.
Can you take it from here?

Code: [Select]

(#<VLA-OBJECT IAcadLine 01e82bbc> "0" 1)
(#<VLA-OBJECT IAcadLine 01e82c5c> "0" 1)
(#<VLA-OBJECT IAcadLine 01e82cfc> "0" 1)
(#<VLA-OBJECT IAcadLine 01e82d9c> "0" 3)
(#<VLA-OBJECT IAcadLine 01e82e3c> "0" 3)
(#<VLA-OBJECT IAcadLine 01e82edc> "0" 3)
(#<VLA-OBJECT IAcadLine 01e82f7c> "0" 256)
(#<VLA-OBJECT IAcadLine 01e8301c> "0" 256)
(#<VLA-OBJECT IAcadLine 01e830bc> "0" 256)
(#<VLA-OBJECT IAcadLine 01e8315c> "0" 256)
(#<VLA-OBJECT IAcadLine 01e831fc> "0" 256)
(#<VLA-OBJECT IAcadLine 01e8289c> "1" 2)
(#<VLA-OBJECT IAcadLine 01e8293c> "1" 2)
(#<VLA-OBJECT IAcadLine 01e829dc> "1" 2)
(#<VLA-OBJECT IAcadLine 01e8275c> "1" 4)
(#<VLA-OBJECT IAcadLine 01e827fc> "1" 4)
(#<VLA-OBJECT IAcadLine 01e82a7c> "1" 256)
(#<VLA-OBJECT IAcadLine 01e82b1c> "1" 256)
(#<VLA-OBJECT IAcadLine 01e8243c> "2" 1)
(#<VLA-OBJECT IAcadLine 01e824dc> "2" 1)
(#<VLA-OBJECT IAcadLine 01e8257c> "2" 1)
(#<VLA-OBJECT IAcadLine 01e7ca3c> "2" 5)
(#<VLA-OBJECT IAcadLine 01e8261c> "2" 5)
(#<VLA-OBJECT IAcadLine 01e826bc> "2" 5)
(#<VLA-OBJECT IAcadLine 01e8329c> "2" 256)
(#<VLA-OBJECT IAcadLine 01e8333c> "2" 256)
(#<VLA-OBJECT IAcadLine 01e833dc> "2" 256)
(#<VLA-OBJECT IAcadLine 01df7bbc> "3" 3)
(#<VLA-OBJECT IAcadLine 01e236b4> "3" 3)
(#<VLA-OBJECT IAcadLine 01e7c9e4> "3" 3)
(#<VLA-OBJECT IAcadLine 01c934dc> "3" 6)
(#<VLA-OBJECT IAcadLine 01e822fc> "3" 6)
(#<VLA-OBJECT IAcadLine 01e8239c> "3" 6)
(#<VLA-OBJECT IAcadLine 01e8211c> "3" 256)
(#<VLA-OBJECT IAcadLine 01e821bc> "3" 256)
(#<VLA-OBJECT IAcadLine 01e8225c> "3" 256)

[T.Willey]

If I remember correctly Tim Willey has a layer merge lisp that may work for this.

I don't think I have a layer one, the one I wrote is to chase down layers.  It will look for nested layers and show you where they are.  [>Link<]

What I would do here, is kind of the same method as the one I posted, but would just have a bunch on 'cond' statements to put entities on the correct layer with the correct settings.

[Didge]

Craig,

I've coded something very similar for our GIS conversion issues.

The undernoted coding creates a selection set containing all Lines & LWpolylines on layers 23 & 56 that are coloured red, it then creates a new layer and moves the objects onto that layer while changing their properties to <bylayer> at the same time.

Try adjusting the  (0 . "LINE,LWPOLYLINE") (8 . "23,56") (62 . 1) bits to suit your specific requirements.

I hope that helps.

Didge.

Code: [Select]

(if (setq SSET (ssget "X" '((-4 . "<AND")(0 . "LINE,LWPOLYLINE")(8 . "23,56")(62 . 1)(-4 . "AND>")))) ; Combined Sewers
  (progn
    (if (tblsearch "LAYER" "Gravity_Combined")
      (command "_LAYER" "_THAW" "Gravity_Combined" "_ON" "Gravity_Combined" "")
      (command "_LAYER" "_NEW" "Gravity_Combined" "_COLOR" "1" "Gravity_Combined" "")
    )
    (command "_CHPROP" SSET "" "_LA" "Gravity_Combined" "_C" "BYLAYER" "LT" "BYLAYER" "")
  )
)