Topic: To Modify Block align lisp by ribam

[dussla]

I found this lisp
That lisp is block align

https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/align-blocks-automatically-lisp/td-p/7169917

Code: [Select]


(defun c:scatterblks-with-gaps ( / dispositionmatrix s g i m l b c k rn mn w h bp rh ) (vl-load-com) (defun dispositionmatrix ( n / f k r l ) (setq f (1+ (fix (sqrt (- n 0.5))))) (setq k 0) (repeat f (repeat f (setq k (1+ k)) (if (<= k n) (setq r (cons 1 r)) (setq r (cons 0 r)) ) ) (setq l (cons (reverse r) l) r nil) ) (reverse l) ) (prompt "\nSelect overlapping group of blocks...") (setq s (ssget "_:L" '((0 . "INSERT")))) (initget 4) (setq g (getdist "\nPick or specify gap distance <0.0> : ")) (if (null g) (setq g 0.0) ) (if s (progn (setq i (sslength s)) (setq m (dispositionmatrix i)) (repeat i (setq l (cons (list (acet-ent-geomextents (setq b (ssname s (setq i (1- i))))) b) l)) ) (setq c (mapcar (function (lambda ( x ) (/ x (length l)))) (apply (function mapcar) (cons (function +) (mapcar (function (lambda ( x y ) (mapcar (function (lambda ( a b ) (/ (+ a b) 2))) x y))) (mapcar (function caar) l) (mapcar (function cadar) l)))))) (setq k 0) (foreach r m (foreach v r (if (= v 1) (setq rn (cons (nth k l) rn) k (1+ k)) (setq rn (cons nil rn)) ) ) (setq mn (cons (reverse rn) mn) rn nil) ) (setq mn (reverse mn)) (setq w (apply (function max) (mapcar (function (lambda ( x ) (apply (function +) (mapcar (function (lambda ( y ) (if y (abs (- (car (cadr (car y))) (car (car (car y))))) 0.0))) x)))) mn))) (setq h (apply (function max) (mapcar (function (lambda ( x ) (apply (function +) (mapcar (function (lambda ( y ) (if y (abs (- (cadr (cadr (car y))) (cadr (car (car y))))) 0.0))) x)))) (apply (function mapcar) (cons (function list) mn))))) (setq bp (mapcar (function -) c (list (+ (/ w 2) (/ (* (1- (length (car m))) g) 2)) (+ (/ h 2) (/ (* (1- (length m)) g) 2))))) (setq rh 0.0) (foreach rn mn (setq bp (mapcar (function +) bp (list 0.0 rh))) (setq rh 0.0) (foreach vn rn (if vn (progn (vla-move (vlax-ename->vla-object (cadr vn)) (vlax-3d-point (caar vn)) (vlax-3d-point bp)) (setq bp (mapcar (function +) bp (list (+ g (abs (- (car (cadr (car vn))) (car (car (car vn)))))) 0.0))) ) ) (if (and vn (< rh (+ g (abs (- (cadr (cadr (car vn))) (cadr (car (car vn)))))))) (setq rh (+ g (abs (- (cadr (cadr (car vn))) (cadr (car (car vn))))))) ) ) (setq bp (subst (- (car c) (+ (/ w 2) (/ (* (1- (length (car m))) g) 2))) (car bp) bp)) ) ) ) (princ) )


I changed  block  selection -> polyline
But i want to  align by area
Small size -> big size

Sorry many ask
How can i modify that ?

[ribarm]

So what if it's black background... I was experimenting with HTML options...

Ako bas hoces, evo neceg novog...

Code - Auto/Visual Lisp: [Select]

1. (defun c:rhomb ( / *error* rec gr p a b p1 p2 p3 p4 )
2.  
3.   (vl-load-com)
4.  
5.   (defun *error* ( m )
6.     (if m
7.       (prompt m)
8.     )
9.     (princ)
10.   )
11.  
12.   (entmake
13.     (list
14.       (cons 0 "CIRCLE")
15.       (list 10 0.0 0.0 0.0)
16.       (list 40 1.0)
17.     )
18.   )
19.   (setq rec
20.     (entmakex
21.       (list
22.         (cons 0 "LWPOLYLINE")
23.         (cons 100 "AcDbEntity")
24.         (cons 100 "AcDbPolyline")
25.         (cons 90 4)
26.         (cons 70 (1+ (* 128 (getvar 'plinegen))))
27.         (cons 38 0.0)
28.         (list 10 0.0 0.0)
29.         (list 10 1.0 0.0)
30.         (list 10 1.0 1.0)
31.         (list 10 0.0 1.0)
32.         (list 210 0.0 0.0 1.0)
33.       )
34.     )
35.   )
36.   (vla-zoomwindow (vlax-get-acad-object) (vlax-3d-point (list -2.0 -2.0)) (vlax-3d-point (list 2.0 2.0)))
37.   (while (/= 3 (car (setq gr (grread t))))
38.     (setq p (cadr gr))
39.     (setq a (angle (list 0.0 0.0) p))
40.     (setq b (+ a (* 0.25 pi)))
41.     (setq p1 (list 0.0 0.0) p2 (list (cos a) (sin a)) p3 (polar (list 0.0 0.0) b (+ (sqrt 2.0) (* (- 2.0 (sqrt 2.0)) (/ (* 0.25 pi) a)))) p4 (list (sin a) (cos a)))
42.     (entupd (cdr (assoc -1 (entmod (mapcar (function (lambda ( x y ) (if (= (car x) 10) (cons 10 y) x))) (entget rec) (list p1 p2 p3 p4))))))
43.   )
44.   (*error* nil)
45. )
46.  

M.R.

[JohnK]

So what if it's black background... I was experimenting with HTML options...
...

Huh?! You alright ribarm (that response doesn't make sense)?

[ribarm]

(defun c:rhomb ( / *error* rec recx gr p a b p1 p2 p3 p4 k )

  (vl-load-com)

  (defun *error* ( m )
    (if m
      (prompt m)
    )
    (princ)
  )

  (entmake
    (list
      (cons 0 "CIRCLE")
      (list 10 0.0 0.0 0.0)
      (cons 40 1.0)
    )
  )
  (setq rec
    (entmakex
      (list
        (cons 0 "LWPOLYLINE")
        (cons 100 "AcDbEntity")
        (cons 100 "AcDbPolyline")
        (cons 90 4)
        (cons 70 (1+ (* 128 (getvar 'plinegen))))
        (cons 38 0.0)
        (list 10 0.0 0.0)
        (list 10 1.0 0.0)
        (list 10 1.0 1.0)
        (list 10 0.0 1.0)
        (list 210 0.0 0.0 1.0)
      )
    )
  )
  (setq recx (entget rec))
  (vla-zoomwindow (vlax-get-acad-object) (vlax-3d-point (list -2.0 -2.0)) (vlax-3d-point (list 2.0 2.0)))
  (while (/= 3 (car (setq gr (grread t))))
    (setq p (cadr gr))
    (setq a (angle (list 0.0 0.0) p))
    (setq aa (rem a (* 0.5 pi)))
    (setq b (+ a (* 0.25 pi)))
    (setq p1 (list 0.0 0.0))
    (setq p3 (polar (list 0.0 0.0) b (+ (sqrt 2.0) (* (- 2.0 (sqrt 2.0)) (progn (if (> aa (* 0.25 pi)) (if (< (- (* 0.25 pi) (- aa (* 0.25 pi))) 0.0) (abs (- (* 0.25 pi) (- aa (* 0.25 pi)))) (- (* 0.25 pi) (- aa (* 0.25 pi)))) aa))))))
    (setq p2 (polar (list (/ (car p3) 2.0) (/ (cadr p3) 2.0)) (- b (* 0.5 pi)) (- (/ (sqrt 2.0) 2.0) (* (/ (sqrt 2.0) 2.0) (progn (if (> aa (* 0.25 pi)) (if (< (- (* 0.25 pi) (- aa (* 0.25 pi))) 0.0) (abs (- (* 0.25 pi) (- aa (* 0.25 pi)))) (- (* 0.25 pi) (- aa (* 0.25 pi)))) aa))))))
    (setq p4 (polar (list (/ (car p3) 2.0) (/ (cadr p3) 2.0)) (+ b (* 0.5 pi)) (- (/ (sqrt 2.0) 2.0) (* (/ (sqrt 2.0) 2.0) (progn (if (> aa (* 0.25 pi)) (if (< (- (* 0.25 pi) (- aa (* 0.25 pi))) 0.0) (abs (- (* 0.25 pi) (- aa (* 0.25 pi)))) (- (* 0.25 pi) (- aa (* 0.25 pi)))) aa))))))
    (setq k nil)
    (entupd (cdr (assoc -1 (entmod (setq recx (mapcar (function (lambda ( x ) (if (= (car x) 10) (progn (setq k (if (not k) 0 (1+ k))) (cons 10 (nth k (list p1 p2 p3 p4)))) x))) recx))))))
  )
  (*error* nil)
)

;;; Sta je starije, rhomb, square, rectangle ili jaje... Sunce ili svetionik, borac ili vekovnik...
;;; Pa naravno, odlucite sami, ali i pored toga postoje i others cudi...
;;; Sto se tice trojstva covek, pas, macka ili Bog, sin, znacka... Otkucaje povezuje i predskazuje godisnjak sveta svetova slave...
;;; E sad, ovo sa tornadima je egzibicija na ksi, pa posto je Bogu draza od psi, onda je i lambda sama kao fama, a gamma prazna kao tama...