Jump to content

help with lisp nested blocks


johny4901

Recommended Posts

Hi all,

 

I have a lisp for using attributes, but this lisp doen't work with nested blocks, could someone tell me how to solve this.

 

;;local defun
;;helper method to group a list of items by their tags
(defun group-by-car (lst)
;;ensure that the list is not empty
(if lst
(cons
(vl-remove-if-not
;;this is a lambda function to compare the equality of the tags
(function (lambda (x)
(equal (car x) (caar lst) 0.00001)))
lst
)
;;recursive call to group a sublist
(group-by-car
(vl-remove-if
(function (lambda (x)
(equal (car x) (caar lst) 0.00001)))
lst))))
)


;;main program
;;define the main function, localize all variables.
(defun C:SUMTABLE (/ acsp att atts block_obj data en ent_list item
match_list pt sset tag tags tmp)
;;look for block
(if (not (tblsearch "block" "GKW_Totaal"))
(progn
;;if it is not found, alert user and exit program
(alert "Block \"GKW_Totaal\" does not exist. Exit program.")
(exit)(princ))
)

(setq acsp (vla-get-block ;;get the block representation of the layout
(vla-get-activelayout ;;get the current layout
(vla-get-activedocument ;;get the current drawing
(vlax-get-acad-object)))) ;;get AutoCAD application
)
;;create a list to match attribute tags
(setq match_list (list "GKW" "FLOW" "KPA"))

;;get a selection set of all blocks with attributes
(setq sset (ssget (list (cons 0 "INSERT") (cons 66 1)))
)
;;start to loop through selection set
(while (setq en (ssname sset 0))
;;add current entity to a list of entities
(setq ent_list (cons en ent_list))
;;get the first attribute from the entity
(setq att (entnext en))
;;start while loop through attributes in the block
(while (/= (cdr (assoc 0 (entget att))) "SEQEND")
;;if there is an attribute
(if (and att
;;AND its tag is in the list of tags to match
(member (setq tag (cdr (assoc 2 (entget att)))) match_list))
;;then get the value from the tag and place into a dotted pair list
(setq tags (cons (cons tag (cdr (assoc 1 (entget att)))) tags)))
;;get the next attribute
(setq att (entnext att)))
;;deletes an entity from the current selection set
(ssdel en sset)
)
;;loop through each pair of dotted pairs in the tags list
(foreach item (group-by-car tags)
;;if the tag is KPA...
(if (eq (caar item) "KPA")
;;get the maximum for KPA
(setq tmp (list (caar item)
(vl-princ-to-string (apply 'max (mapcar 'atof (mapcar 'cdr item))))))
;;otherwise, sum all other values together
(setq tmp (list (caar item)
(vl-princ-to-string (apply '+ (mapcar 'atof (mapcar 'cdr item))))))
)
;;NOTE: mapcar is used to apply a function to a list of items. The function is applied
;;to every item in the list. atof will turn a string into a real number

;;add the computed values to a list
(setq data (cons tmp data)
)
)

;;turn all values into strings, rtos is used to accomplish this
(setq data (mapcar (function (lambda(x)
(cons (car x)
(rtos (atoi (cadr x)) 2 0))))
data
)
)
;;prompt user for an insertion point
(setq pt (getpoint "\nSpecify insertion point of the block: ")
)
;;insert a block with a scale of 1 and rotation of 0
(setq block_obj (vlax-invoke acsp 'Insertblock pt "GKW_Totaal" 1 1 1 0))
;;get the attributes for the inserted block
(setq atts (vlax-invoke block_obj 'GetAttributes))
;;loop through the attributes in the inserted block
(foreach att atts
;;if the tag for the attribute is found...
(if (setq item (assoc (vla-get-tagstring att) data))
;;put the value into the attribute
(vla-put-textstring att (cdr item)))
)
;;silent exit
(princ)
)
;;inform the user how to start the program
(prompt "\n\t\t***\tType SUMTABLE to execute\t***")
(prin1)
;;load VL* functions
(vl-load-com)

Link to comment
Share on other sites

Deciphering a program is at best a tedious task.

 

Giving more details will help people really solve your problem.

 

Can you describe in short

1. what is it that you want to achieve?

2. What exactly is going wrong?

 

Maybe an example of original drawing, the drawing with desired results and the drawing showing the results you are actually getting could be a great help.

 

This can be good starting point. People may need further details that you will need to provide.

 

This way it will be easier for us to configure a probable solution to the problem.

 

If you haven't got the solution yet, provide these details.

 

- Sanjay Kulkarni

Link to comment
Share on other sites

what we are doing is put a cooling system in ceiling tiles, the tiles are allready a block and the cooling is a dynamic block which is fitted in the the tile and saved as a new wblock, the program above will counts the values together ( I need to ajust this with some more formulas after this is solved), see example of a drawing.:)

testplafond.dwg

GKW_Totaal.dwg

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...