See the top rated post in this thread. Click here

Results 1 to 8 of 8

Thread: Need help changing some code regarding selection sets

  1. #1
    Member
    Join Date
    2012-03
    Location
    Gaborone, Botswana (Southern Africa)
    Posts
    4
    Login to Give a bone
    0

    Default Need help changing some code regarding selection sets

    Background:

    I have code for a script that takes all polylines in the dwg and sums up their lengths by layer and exports to excel.

    Code:
    (defun c:ple (/ elist  en   i    layer    layer_list
      leng  pline   row    ss     sumlen   total
      x  xlApp   xlBook   xlBooks  xlCells  xlSheet
      xlSheets
            )
      (vl-load-com)
      (setq xlApp    (vlax-get-or-create-object "Excel.Application")
     xlBooks  (vlax-get-property xlApp "Workbooks")
     xlBook    (vlax-invoke-method xlBooks "Add")
     xlSheets (vlax-get-property xlBook "Sheets")
     xlSheet    (vlax-get-property xlSheets "Item" 1)
     xlCells    (vlax-get-property xlSheet "Cells")
      ) 
      (vla-put-visible xlApp :vlax-true)
      ;headers
      (vlax-put-property xlCells "Item" 1 1 "Layer")
      (vlax-put-property xlCells "Item" 1 2 "Length")
     
      (setq row 2
     total 0)
      (setq ss (ssget "_X" (list (cons 0 "*POLYLINE"))) i -1)
      (repeat (sslength ss)
        (setq en (ssname ss (setq i (1+ i)))
       elist (entget en)
       layer (cdr (assoc 8 elist)))
        (if (not (member layer layer_list))
          (setq layer_list (cons layer layer_list))))
     
     
      (repeat (length layer_list)
        (setq layer (car layer_list))
        (vlax-put-property xlCells "Item" row 1 layer)
        (setq ss (ssget "_X" (list (cons 0 "*POLYLINE")(cons 8 layer))) i -1 sumlen 0)
        (repeat (sslength ss)
        (setq row (1+ row))  
        (setq pline (vlax-ename->vla-object (ssname ss (setq i (1+ i)))))
        (setq leng  (vlax-curve-getdistatparam pline
        (vlax-curve-getendparam pline)))
        (vlax-put-property xlCells "Item" row 2 (rtos leng 2 3))
        ;;;    (vlax-put-property xlCells "Item" row 2 (rtos leng 2 3)); for metric units  
        (setq sumlen (+ sumlen leng)))
        (setq row (1+ row))
        (vlax-put-property xlCells "Item" row 1 "SubTotal:")
        (vlax-put-property xlCells "Item" row 2 (rtos sumlen 2 3))
        (setq total (+ total sumlen))
    ;;;    (vlax-put-property xlCells "Item" row 2 (rtos sumlen 2 3)); for metric units
        (setq layer_list (cdr layer_list))
        (setq row (+ row 2))
     
      ) 
    ; footers:
    (vlax-put-property xlCells "Item" row 1 "Total:")
    (vlax-put-property xlCells "Item" row 2 (rtos total 2 3))
    ;;;(vlax-put-property xlCells "Item" row 2 (rtos total 2 3)); for metric units  
    (mapcar (function (lambda(x)
          (vl-catch-all-apply
            (function (lambda()
          (progn
            (vlax-release-object x)
            (setq x nil)))))))
    (list xlCells xlSheet xlSheets xlBook xlBooks xlApp)
    )
    (alert "Close Excel file manually")
    (gc)(gc)
    (princ)
      )
    (princ "\t\t***\t  Type PLE to write polines length to Excel\t***")
    (princ)

    Problem:

    The problem is that it calculates the lenghths of ALL polylines in the drawing.
    I would like it if it only calculated the lengths of the polylines from my selection and sent the totals to excel by layer.


    My take:

    I have identified two instances of the ssget function in the code and it is choosing all the entities.

    The first instance of ssget makes a list of layers with polylines.

    Code:
    (setq ss (ssget "_X" (list (cons 0 "*POLYLINE"))) i -1)

    If i remove "_X" it asks the user for selection, which is what i want.

    The problem comes in later on in the script when it makes a new selection set to get measurements.
    Code:
    (setq ss (ssget "_X" (list (cons 0 "*POLYLINE")(cons 8 layer))) i -1 sumlen 0)
    I would like it if these operations didnt take place on the selection set of all entities. Please help me change the above line so it performs the same function but on the selection set the user selected earlier.

  2. #2
    All AUGI, all the time
    Join Date
    2015-10
    Location
    Belgrade, Serbia, Europe
    Posts
    564
    Login to Give a bone
    1

    Default Re: Need help changing some code regarding selection sets

    Add this to start of your code :
    Code:
    (defun _ssget ( ss assocfilter / ssnew n ent lst )
      (setq ssnew (ssadd))
      (repeat (setq n (sslength ss))
        (setq ent (ssname ss (setq n (1- n))))
        (foreach assoc assocfilter
          (if (member assoc (entget ent)) (setq lst (cons T lst)) (setq lst (cons nil lst)))
        )
        (if (eval (cons 'and lst)) (ssadd ent ssnew))
      )
      ssnew
    )
    Change line :
    Code:
    (defun c:ple ( / elist en i layer layer_list leng pline row ss sumlen total x xlApp xlBook xlBooks xlCells xlSheet xlSheets)
    ...
    To this :
    Code:
    (defun c:ple ( / elist en i layer layer_list leng pline row ss sss sumlen total x xlApp xlBook xlBooks xlCells xlSheet xlSheets)
    ...
    Change lines :
    Code:
    (setq ss (ssget "_X" (list (cons 0 "*POLYLINE"))) i -1)
    (repeat (sslength ss)
      (setq en (ssname ss (setq i (1+ i)))
      elist (entget en)
      layer (cdr (assoc 8 elist)))
      (if (not (member layer layer_list))
        (setq layer_list (cons layer layer_list))
      )
    )
    To this :
    Code:
    (setq sss (ssget (list (cons 0 "*POLYLINE"))) i -1)
    (repeat (sslength sss)
      (setq en (ssname sss (setq i (1+ i)))
      elist (entget en)
      layer (cdr (assoc 8 elist)))
      (if (not (member layer layer_list))
        (setq layer_list (cons layer layer_list))
      )
    )
    Change line :
    Code:
    (setq ss (ssget "_X" (list (cons 0 "*POLYLINE")(cons 8 layer))) i -1 sumlen 0)
    To this :
    Code:
    (setq ss (_ssget sss (list (cons 0 "*POLYLINE")(cons 8 layer))) i -1 sumlen 0)
    This should fix the problem, though not tested...
    M.R.
    Last edited by marko_ribar; 2012-03-28 at 12:16 PM.

  3. #3
    Member
    Join Date
    2012-03
    Location
    Gaborone, Botswana (Southern Africa)
    Posts
    4
    Login to Give a bone
    0

    Default Re: Need help changing some code regarding selection sets

    Thanks for the help marko.

    I changed the script as you specified but i'm getting an error when i run it.

    ---------------------------
    Question
    ---------------------------
    Assignment to protected symbol:
    ASSOC
    Enter break loop?
    ---------------------------
    Yes No
    ---------------------------

  4. #4
    All AUGI, all the time
    Join Date
    2015-10
    Location
    Belgrade, Serbia, Europe
    Posts
    564
    Login to Give a bone
    0

    Default Re: Need help changing some code regarding selection sets

    The first defun - change to :

    Code:
    (defun _ssget ( ss assocfilter / ssnew n ent lst )
      (setq ssnew (ssadd))
      (repeat (setq n (sslength ss))
        (setq ent (ssname ss (setq n (1- n))))
        (foreach assocc assocfilter
          (if (member assocc (entget ent)) (setq lst (cons T lst)) (setq lst (cons nil lst)))
        )
        (if (eval (cons 'and lst)) (ssadd ent ssnew))
        (setq lst nil)
      )
      ssnew
    )
    M.R.
    Last edited by marko_ribar; 2012-03-28 at 07:07 PM. Reason: added (setq lst nil)

  5. #5
    Member
    Join Date
    2012-03
    Location
    Gaborone, Botswana (Southern Africa)
    Posts
    4
    Login to Give a bone
    0

    Default Re: Need help changing some code regarding selection sets

    G'mornin,

    I tried that. The ASSOC error is now gone, the script runs without any runtime errors.

    BUT the measurements are failing, all 0.

    Excel shows

    Layer Length
    SAE wireways P8000
    SubTotal: 0

    SAE Wireways 200mm tray
    SubTotal: 0

    SAE wireways systems basket 100mm
    SubTotal: 0

    SAE wireways system 150
    SubTotal: 0

    SAE SMALLPOWER
    SubTotal: 0

    SAE Smallpowerskirting
    SubTotal: 0

    SAE Smallpower_skirting
    SubTotal: 0

    Total: 0


    what the scipt looks like now

    Code:
    (defun _ssget ( ss assocfilter / ssnew n ent lst )
      (setq ssnew (ssadd))
      (repeat (setq n (sslength ss))
        (setq ent (ssname ss (setq n (1- n))))
        (foreach assocc assocfilter
          (if (member assocc (entget ent)) (setq lst (cons T lst)) (setq lst (cons nil lst)))
        )
        (if (eval (cons 'and lst)) (ssadd ent ssnew))
        (setq lst nil)
      )
      ssnew
    )
    (defun c:ple (/ elist  en   i    layer    layer_list
      leng  pline   row    ss sss    sumlen   total
      x  xlApp   xlBook   xlBooks  xlCells  xlSheet
      xlSheets
            )
      (vl-load-com)
      (setq xlApp    (vlax-get-or-create-object "Excel.Application")
     xlBooks  (vlax-get-property xlApp "Workbooks")
     xlBook    (vlax-invoke-method xlBooks "Add")
     xlSheets (vlax-get-property xlBook "Sheets")
     xlSheet    (vlax-get-property xlSheets "Item" 1)
     xlCells    (vlax-get-property xlSheet "Cells")
      ) 
      (vla-put-visible xlApp :vlax-true)
      ;headers
      (vlax-put-property xlCells "Item" 1 1 "Layer")
      (vlax-put-property xlCells "Item" 1 2 "Length")
      
      (setq row 2
     total 0)
      (setq sss (ssget (list (cons 0 "*POLYLINE"))) i -1)
      (repeat (sslength sss)
        (setq en (ssname sss (setq i (1+ i)))
       elist (entget en)
       layer (cdr (assoc 8 elist)))
        (if (not (member layer layer_list))
          (setq layer_list (cons layer layer_list))))
      
      
      (repeat (length layer_list)
        (setq layer (car layer_list))
        (vlax-put-property xlCells "Item" row 1 layer)
        (setq ss (_ssget sss (list (cons 0 "*POLYLINE")(cons 8 layer))) i -1 sumlen 0)
        (repeat (sslength ss)
        (setq row (1+ row))  
        (setq pline (vlax-ename->vla-object (ssname ss (setq i (1+ i)))))
        (setq leng  (vlax-curve-getdistatparam pline
        (vlax-curve-getendparam pline)))
        (vlax-put-property xlCells "Item" row 2 (rtos leng 2 3))   
        (setq sumlen (+ sumlen leng)))
        (setq row (1+ row))
        (vlax-put-property xlCells "Item" row 1 "SubTotal:")
        (vlax-put-property xlCells "Item" row 2 (rtos sumlen 2 3))
        (setq total (+ total sumlen))
        (setq layer_list (cdr layer_list))
        (setq row (+ row 2))
        
      ) 
    ; footers:
    (vlax-put-property xlCells "Item" row 1 "Total:")
    (vlax-put-property xlCells "Item" row 2 (rtos total 2 3))
    (mapcar (function (lambda(x)
          (vl-catch-all-apply
            (function (lambda()
          (progn
            (vlax-release-object x)
            (setq x nil)))))))
    (list xlCells xlSheet xlSheets xlBook xlBooks xlApp)
    )
    (alert "Close Excel file manually")
    (gc)(gc)
    (princ)
      )
    (princ "\t\t***\t  Type PLE to write polines length to Excel\t***")
    (princ)

  6. #6
    All AUGI, all the time
    Join Date
    2015-10
    Location
    Belgrade, Serbia, Europe
    Posts
    564
    Login to Give a bone
    0

    Default Re: Need help changing some code regarding selection sets

    Change this line :
    Code:
    (setq ss (_ssget sss (list (cons 0 "*POLYLINE")(cons 8 layer))) i -1 sumlen 0)
    To this :
    Code:
    (setq ss (_ssget sss (list (cons 0 "LWPOLYLINE")(cons 8 layer))) i -1 sumlen 0)
    And before you execute routine convert all old heavy POLYLINE entities to LWPOLYLINE entities, or add this line at the beginning just after (defun c:... ( / ...) :
    Code:
    (vl-cmdf "_.convert" "p" "a")
    Note : This routine will calculate only lengths of 2D polyline objects...
    If you have 3D polylines that you want to consider in calculations, you must use :
    Code:
    (setq ss (_ssget sss (list (cons 0 "POLYLINE")(cons 8 layer))) i -1 sumlen 0)
    but then all LWPOLYLINE objects will be omitted...

    So maybe the best way would be to convert all LWPOLYLINE objects to old heavy POLYLINE objects and use :
    Code:
    (setq ss (_ssget sss (list (cons 0 "POLYLINE")(cons 8 layer))) i -1 sumlen 0)
    but I don't quite know how to do conversion...

    Sincerely, M.R.

  7. #7
    All AUGI, all the time
    Join Date
    2015-10
    Location
    Belgrade, Serbia, Europe
    Posts
    564
    Login to Give a bone
    0

    Default Re: Need help changing some code regarding selection sets

    Little bit more complex, but try it (not tested - now whole code) :

    Code:
    (defun ss=ss1+ss2 ( ss1 ss2 / lst1 n1 lst2 n2 lst n ss )
      (setq n1 (if (vl-catch-all-error-p (vl-catch-all-apply 'sslength (list ss1))) 0 (sslength ss1)))
      (repeat n1
        (setq lst1 (cons (ssname ss1 (setq n1 (1- n1))) lst1))
      )
      (setq n2 (if (vl-catch-all-error-p (vl-catch-all-apply 'sslength (list ss2))) 0 (sslength ss2)))
      (repeat n2
        (setq lst2 (cons (ssname ss2 (setq n2 (1- n2))) lst2))
      )
      (if (eq lst1 nil) (setq lst lst2))
      (if (eq lst2 nil) (setq lst lst1))
      (if (and lst1 lst2)
      (progn
      (foreach ent lst2
        (if (not (member ent lst1)) (setq lst (cons ent lst)))
      )
      (setq lst (append lst1 lst))
      )
      )
      (setq ss (ssadd))
      (foreach ent lst
        (ssadd ent ss)
      )
      ss
    )
    (defun _ssget ( ss assocfilter / ssnew n ent lst )
      (setq ssnew (ssadd))
      (repeat (setq n (sslength ss))
        (setq ent (ssname ss (setq n (1- n))))
        (foreach assocc assocfilter
          (if (member assocc (entget ent)) (setq lst (cons T lst)) (setq lst (cons nil lst)))
        )
        (if (eval (cons 'and lst)) (ssadd ent ssnew))
        (setq lst nil)
      )
      ssnew
    )
    (defun c:ple (/ elist  en   i    layer    layer_list
      leng  pline   row  ss ss1 ss2 sss    sumlen   total
      x  xlApp   xlBook   xlBooks  xlCells  xlSheet
      xlSheets
            )
      (vl-load-com)
      (setq xlApp    (vlax-get-or-create-object "Excel.Application")
     xlBooks  (vlax-get-property xlApp "Workbooks")
     xlBook    (vlax-invoke-method xlBooks "Add")
     xlSheets (vlax-get-property xlBook "Sheets")
     xlSheet    (vlax-get-property xlSheets "Item" 1)
     xlCells    (vlax-get-property xlSheet "Cells")
      ) 
      (vla-put-visible xlApp :vlax-true)
      ;headers
      (vlax-put-property xlCells "Item" 1 1 "Layer")
      (vlax-put-property xlCells "Item" 1 2 "Length")
      
      (setq row 2
     total 0)
      (setq sss (ssget (list '(0 . "*POLYLINE") '(-4 . "<or") '(70 . 0) '(70 . 1) '(-4 . "or>"))) i -1)
      (repeat (sslength sss)
        (setq en (ssname sss (setq i (1+ i)))
       elist (entget en)
       layer (cdr (assoc 8 elist)))
        (if (not (member layer layer_list))
          (setq layer_list (cons layer layer_list))))
      
      
      (repeat (length layer_list)
        (setq layer (car layer_list))
        (vlax-put-property xlCells "Item" row 1 layer)
        (setq ss1 (_ssget sss (list (cons 0 "LWPOLYLINE")(cons 8 layer))) ss2 (_ssget sss (list (cons 0 "POLYLINE")(cons 8 layer))) i -1 sumlen 0)
        (setq ss (ss=ss1+ss2 ss1 ss2))
        (repeat (sslength ss)
        (setq row (1+ row))  
        (setq pline (vlax-ename->vla-object (ssname ss (setq i (1+ i)))))
        (setq leng  (vlax-curve-getdistatparam pline
        (vlax-curve-getendparam pline)))
        (vlax-put-property xlCells "Item" row 2 (rtos leng 2 3))   
        (setq sumlen (+ sumlen leng)))
        (setq row (1+ row))
        (vlax-put-property xlCells "Item" row 1 "SubTotal:")
        (vlax-put-property xlCells "Item" row 2 (rtos sumlen 2 3))
        (setq total (+ total sumlen))
        (setq layer_list (cdr layer_list))
        (setq row (+ row 2))
        
      ) 
    ; footers:
    (vlax-put-property xlCells "Item" row 1 "Total:")
    (vlax-put-property xlCells "Item" row 2 (rtos total 2 3))
    (mapcar (function (lambda(x)
          (vl-catch-all-apply
            (function (lambda()
          (progn
            (vlax-release-object x)
            (setq x nil)))))))
    (list xlCells xlSheet xlSheets xlBook xlBooks xlApp)
    )
    (alert "Close Excel file manually")
    (gc)(gc)
    (princ)
      )
    (princ "\t\t***\t  Type PLE to write polines length to Excel\t***")
    (princ)
    Regards, M.R.
    Last edited by marko_ribar; 2012-04-04 at 02:51 PM. Reason: changed (ss=ss1+ss2) sub-function and (ssget (list '(0 . "*POLYLINE") '(-4 . "<or") '(70 . 0) '(70 . 1) '(-4 . "or>")))

  8. #8
    Member
    Join Date
    2012-03
    Location
    Gaborone, Botswana (Southern Africa)
    Posts
    4
    Login to Give a bone
    0

    Default Re: Need help changing some code regarding selection sets

    G'mornin Marko...

    The script works flawlessly now. I tested it againt a few test cases.

    Thanks for your help, I really appreciate it.

    Have a nice day

Similar Threads

  1. Code Sets and Subassemblies in Data Shortcuts
    By Wish List System in forum Civil 3D Wish List
    Replies: 0
    Last Post: 2014-06-30, 12:08 PM
  2. Changing color of selection sets
    By algirdas.vazgys405165 in forum AutoLISP
    Replies: 3
    Last Post: 2013-07-28, 08:42 AM
  3. Selection sets
    By garethace in forum DV - Tutorials
    Replies: 0
    Last Post: 2010-06-01, 09:46 AM
  4. Other (selection sets)
    By gketter in forum AutoCAD LT - Wish List
    Replies: 5
    Last Post: 2005-10-26, 07:11 AM
  5. Help relating to selection and selection sets
    By csgohjmj in forum AutoLISP
    Replies: 3
    Last Post: 2004-09-17, 03:35 PM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •