Author Topic: LISP TO DISTRIBUTE BLOCKS WITH UNIFORM MEASURES (HELP)  (Read 1861 times)

0 Members and 1 Guest are viewing this topic.

esaez

  • Guest
LISP TO DISTRIBUTE BLOCKS WITH UNIFORM MEASURES (HELP)
« on: June 21, 2016, 09:20:24 PM »
someone can help me with a lisp that can evenly distribute blocks. attached an image where the value of "x" must be equal. the idea is that you can change at any time the value of "x" so they can see more or less adjusted according to whatever you want.
Deputy dwg.
 
 
PDTA: research found a lisp teacher Lee Mac, but when you run the lisp then have to update the attributes of each block to return to his position; also they are not exactly the same distance.
associate the lisp "eqsp" - "Lee Mac".

aswin

  • Mosquito
  • Posts: 12
Re: LISP TO DISTRIBUTE BLOCKS WITH UNIFORM MEASURES (HELP)
« Reply #1 on: June 22, 2016, 12:39:47 AM »
I think you are looking for this..  few days before i requested for a similar Lisp & i got this


(defun _bboxandmid (obj / a b l)
  (vla-getboundingbox obj 'a 'b)
  (list (car (setq l (mapcar 'vlax-safearray->list (list a b))))
        (apply '(lambda (a b) (mapcar '(lambda (a b) (/ (+ a b) 2.)) a b)) l)
        (cadr l)
  )
)
 
(defun ss->lst (ss / i l)
  (if (eq (type ss) 'pickset)
    (repeat (setq i (sslength ss))
      (setq l (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) l))
    )
  )
)
 
(defun c:spb (/ doc fac g lst p1 p2 vec)
  (if
    (and
      (setq lst (ss->lst (ssget "_:L")))
      (or
        (< 1 (length lst))
        (prompt "\nSelection set must contain at least 2 entities ")
      )
      (or
        (setq fixDist (getdist "\nFixed distance or Enter: "))
        T
      )
      (setq p1 (getpoint "\nSpecify first point: "))
    )
    (progn
      (setq doc (vla-get-activedocument (vlax-get-acad-object)))
      (vla-endundomark doc) ; End open undo group.
      (vla-startundomark doc)
      (princ "\nSpecify second point: ")
      (while (eq 5 (car (setq g (grread t 15 0))))
        (redraw)
        (setq p2 (cadr g))
        (setq p2
          (cond
            ((osnap p2 "_END,_MID")) ; Change to suit your needs.
            (p2)
          )
        )
        (if (not (equal p1 p2 1e-4))
          (progn
            (grdraw p1 p2 1 -1)
            (setq fac
              (cond
                (fixDist (/ (distance p1 p2) fixDist))
                ((1- (length lst)))
              )
            )
            (setq vec (trans (mapcar '(lambda (crd1 crd2) (/ (- crd2 crd1) fac)) p1 p2) 1 0 T))
            (vlax-invoke (car lst) 'move (cadr (_bboxandmid (car lst))) (trans p1 1 0))
            (mapcar
              '(lambda (o1 o2 / l)
                 (vlax-invoke o2 'move (cadr (_bboxandmid o2)) (mapcar '+ (cadr (_bboxandmid o1)) vec))
               )
              lst
              (cdr lst)
            )
          )
        )
      )
      (vla-endundomark doc)
    )
  )
  (redraw)
  (princ)
)
« Last Edit: June 22, 2016, 02:37:10 AM by aswin »
Abu Dhabi

roy_043

  • Water Moccasin
  • Posts: 1895
  • BricsCAD 18