Lisp improvement

[steven-g]

I have created a routine to help make schedules, it involves finding the correct sizes of shower trays in an appartment building for calculating the floor and wall tiling, the original drawing contains blocks for the shower tray, sometimes the name gives the size but not always and the program that creates the blocks actually places the centre of the shower as the insertion point, but the geometry is not complete. My idea was just to get the extents of the geometry but that actually gives the wrong size. Attached is an example to show the problem. The actual drawing isn't the problem. And the lisp works just fine, it opens a block in block editor, draws a line from extmin to extmax and then rotates a copy of the line 180° around the zero point, this now gives me the true extents.

 

I'm happy with the results (I'm more than happy with the results) but just wondering how other people might approach the problem. In the dwg I preselect the neccessary shower blocks and the lisp takes just over a  minute to run (76 seconds for 19 blocks), which seems slow but thats still one heck of an improvement on doing the same task manually. Could I improve on that, maybe get at the extents data without opening the block editor for each instance, a drawing has about 20 blocks but the naming is inconsistent so although there are only 4 sizes of shower there are actually about 15 different names so this does need to run on each individual block and they do have various rotation angles.

The drawings are quite large 2-5MB and take a minute to open which could also be a cause of the slow progress.

 

;preselect all shower blocks get the rotation and insert point
;find the true extents of the block and then draw a rectangle and hatch it
(defun shower2( / ss ss1 data ins rot pt1 pt2)
  (setq ss(ssget))	;turn selection into a selection set
  (command "-layer" "m" "shower" "color" "green" "shower" "")	;set the layer and color for new items
  (repeat(sslength ss)
    (setq ss1(ssname ss 0)	;get first block from the selection
          data(entget ss1)	;store dxf data from poly into list ss1
          ins(cdr(assoc 10 data))	;get insertion point of block
          rot(* (/ (cdr(assoc 50 data)) pi) 180)	;get rotation angle of block
    )	  
    (command "-bedit" (cdr (assoc 2 data)))	;open block editor for current block
    (command "line" (getvar 'extmin) (getvar 'extmax) "" "rotate" "l" "" "non" "0,0" "c" "180")	;draw a line for the extents of th block and rotate around 0,0 for symetry
    (setq pt1(list (+ (car ins) (car(getvar 'extmin))) (+ (cadr ins) (cadr(getvar 'extmin))))	;first point of rectangle
          pt2(list (+ (car ins) (car(getvar 'extmax))) (+ (cadr ins) (cadr(getvar 'extmax))))	;second point of rectangle
    )
    (command "bclose" "d")	;close block editor without saving changes
    (command "rectangle" "non" pt1 "non" pt2)	;place a rectangle the same size as the actual shower tray
    (command "rotate" "l" "" "non" ins rot)	;orient the rectangle to match the drawing
    (command "-hatch" "p" "solid" "s" "l" "" "")	;hatch the new footprint
    (ssdel ss1 ss)	;remove the current block from the selection set
  )	;end of repeat loop
  (command "-layer" "m" "0" "")
)

 

I'm hoping to improve on this and then adapt it for many more items, which will need different logical approaches to getting at the required results as this particular one worked out well using the block insertion point and rotation angle.

shower.dwg

[Tharwat]

Hi,

Something like this?

(defun c:shower (/ d e f h i j k n o p q r v w)
  ;; Tharwat - 13.Dec.2018	;;
  (and
    (or (tblsearch "LAYER" "shower")
        (entmake '((0 . "LAYER")
                   (100 . "AcDbSymbolTableRecord")
                   (100 . "AcDbLayerTableRecord")
                   (2 . "shower")
                   (62 . 3)
                   (70 . 0)
                  )
        )
    )
    (or
      (/= 4
          (logand 4
                  (cdr (assoc 70 (entget (tblobjname "LAYER" "shower"))))
          )
      )
      (alert
        "Layer name <shower> is locked.! Unlock then try again."
      )
    )
    (princ "\nSelect blocks to hatch :")
    (setq d (entlast)
          i -1
          o (ssget "_:L" '((0 . "INSERT")))
    )
    (setq v (mapcar 'getvar '(HPNAME CMDECHO CLAYER)))
    (mapcar 'setvar
            '(HPNAME CMDECHO CLAYER)
            '("SOLID" 0 "shower")
    )
    (while (setq n (ssname o (setq i (1+ i))))
      (setq e (entget n)
            r (cdr (assoc 50 e))
      )
      (or (vl-some '(lambda (x) (equal r x 1e-4))
                   (list 0.0 (* pi 0.5) pi (* pi 1.5))
          )
          (setq f (entmod (subst '(50 . 0.0) (assoc 50 e) e)))
      )
      (vla-getboundingbox (vlax-ename->vla-object n) 'j 'k)
      (if (and j
               k
               (setq p (vlax-safearray->list j)
                     q (vlax-safearray->list k)
                     w (entmakex (append '((0 . "LWPOLYLINE")
                                           (100 . "AcDbEntity")
                                           (100 . "AcDbPolyline")
                                           (90 . 4)
                                           (70 . 1)
                                          )
                                         (list (cons 10 p)
                                               (cons 10 (list (car p) (cadr q)))
                                               (cons 10 q)
                                               (cons 10 (list (car q) (cadr p)))
                                         )
                                 )
                       )
               )
          )
        (progn (command "_.-hatch" "S" w "" "")
               (or (eq d (setq h (entlast)))
                   (if f
                     (progn
                       (entmod (subst (cons 50 r) (assoc 50 e) e))
                       (foreach x (list w h)
                         (vlax-invoke
                           (vlax-ename->vla-object x)
                           'rotate
                           (cdr (assoc 10 e))
                           r
                         )
                       )
                       (setq d h f nil)
                     )
                   )
               )
        )
      )
    )
    (mapcar 'setvar '(HPNAME CMDECHO CLAYER) v)
  )
  (princ)
) (vl-load-com)

 

[steven-g]

Certainly a lot quicker about 4 seconds per drawing, but less accurate it only accounts for the actual block size and not the extra tiles that would be covered by the shower which means a difference of 11.5% on floor tile area in the example, I need to get below 1% and preferably a lot less than that.

 

Thanks Tharwat I'm going to enjoy going through your code and seeing where the speed difference occurs first impression is it comes from using 'vla-getboundingbox' which at a guess is a much quicker way of getting at the extents of a block, I can see it makes studying vlisp something I need to do now, I'm still at the basics. And this code wil help a lot.

[Tharwat]

Honestly I did not get the use of your codes other than deducting the area of the block from the floor area via hatching them, so anyway you can modify the codes as per your needs and please feel free to ask if your stuck with any part of the program.

 

Good luck.

[steven-g]

Thank you Tharwat you have opened my world to a whole new range of possibilities, after a first look at your code I was completely lost, but I sat down and played with it and started to see daylight.

I was able to alter this section

(setq 	ix(cadr (assoc 10 e))
	iy(caddr (assoc 10 e))
	p(list (- ix (max (- ix (car(vlax-safearray->list j))) (- (car (vlax-safearray->list k)) ix))) (- iy (max (- iy (cadr (vlax-safearray->list j))) (- (cadr (vlax-safearray->list k)) iy))) 0)
	q(list (+ ix (max (- ix (car(vlax-safearray->list j))) (- (car (vlax-safearray->list k)) ix))) (+ iy (max (- iy (cadr (vlax-safearray->list j))) (- (cadr (vlax-safearray->list k)) iy))) 0)
	w(entmakex (append '((0 . "LWPOLYLINE")
                             (100 . "AcDbEntity")
                             (100 . "AcDbPolyline")
                             (90 . 4)
                             (70 . 1)
                            )
                            (list (cons 10 p)
                                 (cons 10 (list (car p) (cadr q)))
                                 (cons 10 q)
                                 (cons 10 (list (car q) (cadr p)))
                           )
                      )
          )
)

and I now get perfect results in just under 4 seconds per drawing

[Tharwat]

Excellent and I am so glad to hear that.

 

One more enhancement is to assign the left & right coordinates of the bounding box points to variables to avoid the evaluations of the same thing many times along with the insertion point of the selected block as commented in the following codes:

 

NOTE: don't forget to localize the variables in the in the program.

(setq ins (assoc 10 e) ;; 1st variable
      ix  (cadr ins)
      iy  (caddr ins)
      lft (vlax-safearray->list j) ;; 2nd variable
      rgt (vlax-safearray->list k) ;; 3rd variable
      p   (list (- ix
                   (max (- ix (car lft))
                        (- (car rgt) ix)
                   )
                )
                (- iy (max (- iy (cadr lft)) (- (cadr rgt) iy)))
                0
          )
      q   (list (+ ix (max (- ix (car lft)) (- (car rgt) ix)))
                (+ iy (max (- iy (cadr lft)) (- (cadr rgt) iy)))
                0
          )
      w   (entmakex (append '((0 . "LWPOLYLINE")
                              (100 . "AcDbEntity")
                              (100 . "AcDbPolyline")
                              (90 . 4)
                              (70 . 1)
                             )
                            (list (cons 10 p)
                                  (cons 10 (list (car p) (cadr q)))
                                  (cons 10 q)
                                  (cons 10 (list (car q) (cadr p)))
                            )
                    )
          )
)

Best of luck.

[steven-g]

Thanks I did start out doing that and had quite a list of extra variables, but then wanted to see if I could figure out the logic of doing it using the already available variables you had created. I was just missing the insertion point. But it does make sense to cut down on the repetition as much as possible.

 

And thanks once more, this is the first time I have been able to read through a Lisp routine containing vlisp and actually follow the logic of what is going on.

 

PS I had localized the extra variables.

Edited December 14, 2018 by steven-g

[Tharwat]

Hi,

Just wanted to pay your attention is that the LWpolyline does not require three coordinates (x,y,z) but only (x,y) since it is a 2D polyline although that does not hurt if you feed it with three coordinates as you already demonstrated.

Good luck.