Topic: Insert MASKBLOCK at scale / Q-review my code please

[JohnK]

Ugh! I was just forced to write a lisp (first one in a long time). It works but if anyone wants to clean it up or make any improvements...Please, feel free.

I found the getpointobj and stringstrip-end functions lying around so my job was a little easier.

This lisp is supposed to set the scale of a MASKBLOCK when a user picks a point. We use MASKBLOCKS for pipe and duct breaks (using AutoCAD MEP). -e.g. If the user picks the end of a duct this will find the scale the MASKBLOCK should be set to.

Code - Auto/Visual Lisp: [Select]

1. (defun mask_add ( mask-block-name / x obj scale )
2.  
3.   (defun getpointobj ( pt / obj pt )
4.     (setvar "LASTPOINT" pt)
5.     (cond
6.       ((ssget pt)
7.        (setq pt (ssname (ssget pt) 0))
8.        (cond
9.          ;; disable xref objects from the list of items.
10.          ((assoc 2 (entget pt))
11.           (not
12.             (assoc
13.               1
14.               (tblsearch "BLOCK" (cdr (assoc 2 (entget pt)))))) )
15.          ;; otherwise just create an object from picked point.
16.          ((setq obj (vlax-ename->vla-object pt))))) )
17.     obj )
18.  
19.   (defun stringstrip-end ( str char )
20.     ;; Strip the end of a string off.
21.     ;; e.g. (StringStrip-End "This is a test" "i")
22.     ;;   -> "This "
23.     (defun liststriper (lst dec)
24.       (if (= (car lst) dec)
25.         (cdr lst) (liststriper (cdr lst) dec)))
26.     (vl-list->string
27.       (reverse (liststriper (reverse (vl-string->list str)) (ascii char)))))
28.  
29.   (while (not (setq x (getpoint "\nSelect Point: ")))
30.          (princ "\nYou did not select a point, please try again. "))
31.  
32.   (setq obj (getpointobj x))
33.  
34.   (cond
35.     (obj
36.       (cond
37.         ((eq (vlax-get-property obj 'ShapeName) "Rectangular")
38.          (setq scale
39.                (atoi
40.                  (stringstrip-end
41.                    (vlax-get-property obj 'CrossSectionSize) "x"))))
42.         ((eq (vlax-get-property obj 'ShapeName) "Round")
43.          (setq scale
44.                (atoi
45.                  (vlax-get-property obj 'CrossSectionSize))))
46.         )
47.       (princ "\n ")
48.       (command "_.maskadd" "NA" mask-block-name "x" scale "y" scale "z" scale x)
49.       (while (eq (logand (getvar 'cmdactive) 1) 1)
50.              (command PAUSE)) )
51.     )
52.   (princ)
53.  )