Selection of blocks using two attribute values and then sum

Discussion of other Lisp dialects (Arc, Clojure, AutoLisp, XLISP, etc.)

Selection of blocks using two attribute values and then sum

Postby osho327 » Fri Mar 10, 2017 9:20 am

Hello Everyone,

I am a novice in lisp and cannot figure out how to tweak the lisp to get the desired results ,
so i need your help to get this working
I am attaching a dwg file with the blocks that we are dealing with.
Each block has following 8 attributes.

STA. (Station /Controller)
SIZE
IM
GPM
PR
PSI
AREA
HYDZ (Hydrozone)

We need to select blocks first by "STA." (wild card selection) and then refine the list with second attribute called "HYDZ" then display no of blocks selected and the sum of "AREA" attribute of the selected blocks.

I found this lisp on the internet that enables me to select the blocks with one attribute and works with wildcard entry , We need to add second selection criteria to refine the results


Code: Select all
(defun ssattval (val / ss res ref name blk)
  (vl-load-com)
  (or *acad* (setq *acad* (vlax-get-acad-object)))
  (or *acdoc* (setq *acdoc* (vla-get-ActiveDocument *acad*)))
  (setq res (ssadd))
  (if (ssget "_X" '((0 . "INSERT") (66 . 1)))
    (progn
      (vlax-for ref (setq ss (vla-get-ActiveSelectionSet *acdoc*))
        (setq has nil)
        (foreach att (vlax-invoke ref 'GetAttributes)
          (if (wcmatch (strcase (vla-get-TextString att)) (strcase val))
            (setq has T)
          )
        )
        (if has
          (ssadd (vlax-vla-object->ename ref) res)
        )
      )
      (vla-delete ss)
    )
  )
  (if (< 0 (sslength res))
    res
  )
)
 
(defun c:ssattval (/ val)
  (if (setq val (getstring "Enter the value of attribute: "))
    (sssetfirst nil (ssattval val))
  )
  (princ)
)



another code I have that gives me the sum of Area of blocks is

Code: Select all
(defun c:sfXX(/ ss1 ssl ctr area area_total chk2 g2 e1 d1 g0 g2)
            (setfunc)
            (setq   ss1                              (ssget(list(cons 2 "CA*")))
                        ssl                                (1-(sslength ss1))
                        ctr                               0
                        area                            0.0
                        area_total            0.00
                        lu                                 (getvar "LUNITS")
                                    )
            (setvar  "lunits" 2)
            (while(>= ssl ctr)
                        (setq   e1       (ssname ss1 ctr)
                                    d1       (entget e1)
                                    g0       (cdr(assoc 0 d1))
                                    g1       (cdr(assoc 1 d1))
                                    g2       (cdr(assoc 2 d1))
                                    g3       (cdr(assoc 3 d1))
                                    g4       (cdr(assoc 4 d1))
                                    g5       (cdr(assoc 5 d1))
                                    g6       (cdr(assoc 6 d1))
                                    g7       (cdr(assoc 7 d1))
                                               
                                                )
 
                        (if (/= g2 nil)
                                    (setq chk2 (substr g2 1 2) )
                        )
                        (if (= g0 "INSERT")
                                    (if (= chk2 "CA")
                                                (while (/= g2 "AREA")
                                                            (setq   g2       nil
                                                                                    e1       (entnext e1)
                                                                                    d1       (entget e1)
                                                                                    g0       (cdr(assoc 0 d1))
                                                                                    g1       (cdr(assoc 1 d1))
                                                                                    g2       (cdr(assoc 2 d1))
                                                                                    g3       (cdr(assoc 3 d1))
                                                                                    g4       (cdr(assoc 4 d1))
                                                                                    g5       (cdr(assoc 5 d1))
                                                                                    g6       (cdr(assoc 6 d1))
                                                                                    g7       (cdr(assoc 7 d1))
                                                                                   
 
                                                                                    )
 
                                                            (if (= g2 "AREA")
                                                                        (setq   area                (atof (n2 g1))
                                                                                    area_total    (+ area_total area)
                                                                                                )
                                                            )
                                                )
                                    )
                        )
                        (setq ctr(1+ ctr))
            )
 
(princ(strcat "nThe total Area = "(rtos area_total)" Square Feet"))
 
 
            area_total 0.0
            (setvar "LUNITS" lu)
            (resetfunc)
            (princ)
)
 
-------------------------------------------------------
 
(defun n2 (str / a b)
  (repeat (strlen str)
    (if    (< 47 (ascii (setq b (substr str 1 1))) 58)
      (setq a (cons b a))
    )
    (setq str (substr str 2))
  )
  (apply 'strcat (reverse a))
)


There is another code by lee mac for selection of blocks by attributes this also takes wild card entries if this one is easier to modify to filter the selection by second attribute

Code: Select all

;; Select Blocks by Attribute Value - Lee Mac

;; Selects all attributed blocks in the current layout which contain a specified attribute value.

(defun c:sel2 ( / att atx ent idx sel str )
(if (/= "" (setq str (strcase (getstring t "nSpecify attribute value: "))))

(if (and
(setq sel
(ssget "_X"
(list '(0 . "INSERT") '(66 . 1) '(2 . "CA*")
(if (= 1 (getvar 'cvport))
(cons 410 (getvar 'ctab))
'(410 . "Model")

)
)
)
)
(progn
(repeat (setq idx (sslength sel))
(setq ent (ssname sel (setq idx (1- idx)))
att (entnext ent)
atx (entget att)
)
(while
(and (= "ATTRIB" (cdr (assoc 0 atx)))
(not (wcmatch (strcase (cdr (assoc 1 atx))) str))
)
(setq att (entnext att)
atx (entget att)
)
)
(if (= "SEQEND" (cdr (assoc 0 atx)))
(ssdel ent sel)
)
)
(< 0 (sslength sel))
)
)
(sssetfirst nil sel)
(princ (strcat "nNo blocks found with attribute value matching "" str ""."))
)
)
(princ)
)



Thanks in advance
osho327
 
Posts: 1
Joined: Fri Mar 10, 2017 9:12 am

Re: Selection of blocks using two attribute values and then

Postby nuntius » Sun Mar 12, 2017 9:38 am

Hi,

This looks like AutoLISP code, not generic Common Lisp. Many (most?) Common Lisp users don't know AutoCAD.
You might get better results asking on an AutoLISP Forum.
User avatar
nuntius
 
Posts: 530
Joined: Sat Aug 09, 2008 10:44 am
Location: Newton, MA


Return to Other Dialects

Who is online

Users browsing this forum: Bing [Bot] and 1 guest