Marko Ribar Dynamic ISOmetric Routine


;;; Marko Ribar Dynamic ISOmetric Routine
;;; Saved from: https://www.theswamp.org/index.php?topic=52655.0
(defun c:3d ( / massoclst pol1 pol2 bl lst1 lst2 lil p gr pp v lst2n )

(defun massoclst ( key lst )
(if (assoc key lst) (cons (assoc key lst) (massoclst key (cdr (member (assoc key lst) lst)))))
)

(setq pol1 (car (entsel "\nPick LWPOLYLINE...")))
(setq pol2 (entmakex (vl-remove-if (function (lambda ( x ) (vl-position (car x) '(-1 5 330)))) (entget pol1))))
(setq bl (massoclst 42 (entget pol2)))
(setq lst1 (mapcar 'cdr (massoclst 10 (entget pol1))))
(setq lst2 (mapcar 'cdr (massoclst 10 (entget pol2))))
(mapcar (function (lambda ( a b ) (setq lil (cons (entmakex (list '(0 . "LINE") (cons 10 a) (cons 11 b))) lil)))) lst1 lst2)
(setq lil (reverse lil))
(setq p (getpoint "\nPick or specify point : "))
(prompt "\nMove mouse and press \"+\" or \"-\" keys for scale and \"4\" or \"6\" for rotation... To finish left mouse click...")
(while (/= 3 (car (setq gr (grread t))))
(cond
( (and (= 2 (car gr)) (= 43 (cadr gr)))
(setq lst2n (mapcar (function (lambda ( x ) (mapcar '+ pp (mapcar '* (mapcar '- x pp) (list (sqrt 2.0) (sqrt 2.0)))))) lst2n))
)
( (and (= 2 (car gr)) (= 45 (cadr gr)))
(setq lst2n (mapcar (function (lambda ( x ) (mapcar '+ pp (mapcar '* (mapcar '- x pp) (list (/ (sqrt 2.0) 2.0) (/ (sqrt 2.0) 2.0)))))) lst2n))
)
( (and (= 2 (car gr)) (= 52 (cadr gr)))
(setq lst2n (mapcar (function (lambda ( x ) (polar pp (+ (angle pp x) (/ pi 4.0)) (distance pp x)))) lst2n))
)
( (and (= 2 (car gr)) (= 54 (cadr gr)))
(setq lst2n (mapcar (function (lambda ( x ) (polar pp (- (angle pp x) (/ pi 4.0)) (distance pp x)))) lst2n))
)
( t
(if (null pp)
(setq pp (cadr gr))
)
(setq v (mapcar '- pp p))
(if (null lst2n)
(setq lst2n (mapcar (function (lambda ( x ) (mapcar '+ v x))) lst2))
(progn
(setq lst2n (mapcar (function (lambda ( x ) (mapcar '+ (mapcar '- (cadr gr) pp) x))) lst2n))
(setq pp (cadr gr))
)
)
)
)
(entmod (append (vl-remove-if (function (lambda ( x ) (vl-position (car x) '(10 42)))) (entget pol2)) (apply 'append (mapcar (function (lambda ( a b ) (list (cons 10 a) b))) lst2n bl))))
(mapcar (function (lambda ( a x ) (entmod (subst (cons 11 a) (assoc 11 (entget x)) (entget x))))) lst2n lil)
(redraw)
)
(princ)
)

(c:3d)

Advertisements

Axonometric Planes Creator through dynamic rectangles


;;; Axonometric Planes Creator through dynamic rectangles
;;; Saved from here: https://www.theswamp.org/index.php?topic=26111.0

(defun c:apc()
(while (and (setq pt1 (getpoint "\nstartpoint:"))
(setq pt2 (getpoint pt1 "\nendpoint:")))
(command "pline" "non" pt1 "non" pt2 "non" pt2 "non" pt1 "c")
(setq en (entlast))
(prompt (strcat "\nwidth" "(def wid=" (vl-princ-to-string real)"):" ))
(setq test t)
(while TEST
(setq TMP (grread t 4 0))
(setq MODE (car TMP)
PT (cadr TMP)
)

(cond ((= MODE 3)
(setq TEST NIL)
)
((= mode 25)
(entdel en)
(setq TEST NIL)
)
((= MODE 5)
(entdel en)
(setq pt3 pt)
(setq ptl (ls-jx2 pt1 pt2 pt3))
(command "pline" "non" (car ptl) "non" (cadr ptl) "non" (caddr ptl) "non" (cadddr ptl) "c")
(setq en (entlast))
)
((member tmp '((2 13) (2 32)))
(if (= real nil)
(progn
(entdel en)
(setq TEST NIL)
);progn
(progn
(setq pt (getvar "lastpoint"))
(setq ptzz (ls-jx3 pt1 pt2 pt real))
(setq ptl (ls-jx2 pt1 pt2 ptzz))
(command "pline" "non" (car ptl) "non" (cadr ptl) "non" (caddr ptl) "non" (cadddr ptl) "c")
(entdel en)
(setq test nil)

);progn
);if
)
((and (member tmp '((2 49) (2 50)(2 51)(2 52)(2 53)(2 54)(2 55)(2 56)(2 57)(2 48)(2 46)))
(setq asc (cadr tmp)) (/= asc 47) (>= asc 46) ( pdz 0)
(setq ang1 (+ ang (* pi 0.5)))
(setq ang1 (- ang (* pi 0.5)))
);if

);progn
(progn
(if ( pdz 0)
(setq ang1 (+ ang (* pi 0.5)))
(setq ang1 (- ang (* pi 0.5)))
);if
(setq ptz (polar ptt ang1 jl))
);progn
(progn
(if ( pdz 0)
(setq ptz (polar pt2 ang1 (/ jl (sin (- (- ang ang1) 180)))))
(setq ptz (polar pt2 ang1 (/ jl (sin (- (- ang1 ang) 180)))))
);if
);progn
(progn
(setq ang1 (angle pt1 pt))
(if (> pdz 0)
(setq ptz (polar pt1 ang1 (/ jl (sin (- ang1 ang)))))
(setq ptz (polar pt1 ang1 (/ jl (sin (- ang ang1)))))
);if
);progn
);if

);progn
)

ptz

)
(defun ls-get-lineperpt (p p1 p2 / l1 a b c x y z x1 y1 z1 k)
(setq l1 (mapcar '- p2 p1)
a (car l1)
b (cadr l1)
c (last l1)
x (car p)
y (cadr p)
z (last p)
x1 (car p1)
y1 (cadr p1)
z1 (last p1)
)
(if (equal l1 '(0. 0. 0.))
l1
(progn(setq k (/ (+ (* a (- x x1))
(* b (- y y1))
(* c (- z z1))
)
(+ (* a a)
(* b b)
(* c c)
)
)
)
(list (+ x1 (* a k))
(+ y1 (* b k))
(+ z1 (* c k))
)
) )
)
(defun ls-linepointposition (p1 p2 pt wc / p c B C P z)
(setq p pt)
(setq z (apply '+
(mapcar '(lambda (b)
(setq c (- (* (car p) (cadr b)) (* (cadr p) (car b)))
p b
)
c
)
(list p1 p2 pt)
)
)
)
(if (< (abs z) (* wc 0.0614658))
(setq z 0)
(setq z z)
)
)
(c:apc)

Creates Isometric Text

;; Lee Mac
;; ONLY WORKS ON DTEXT
;; Found @ http://www.theswamp.org/index.php?topic=37429.0
(defun c:ist ( / e i j k)
(vl-load-com)
;(setq i (/ pi 6.) j -1.)
(setq i 0 k (/ pi 6.) j -1.)
;; © Lee Mac 2011
(if
(and
(setq e (car (entsel "\nSelect Text: ")))
(eq (vla-get-Objectname (setq e (vlax-ename->vla-object e))) "AcDbText")
(princ "\nPress [Tab] to Change Projection ")
)
(while (= 9 (cadr (grread nil 14 0)))
;(vla-put-rotation e i)
(vla-put-rotation e (* k (1- (* 2 (setq i (rem (+ i (max 0 (setq j (- j)))) 3))))))
;(vla-put-obliqueangle e (setq i (* i (setq j (- j)))))
(vla-put-obliqueangle e (* j k))
)
)
(princ)
)
(c:ist)

Create aksonometric drawing from orthogonal drawing

;|
Psevdo-Aksonometr gorizontal ver 3.3

All rights reserved including right of reproduction in whole or in part in ang form.

Перевод прямоугольного чертежа (плана) из плоскости "XY <90" в псевдоаксонометрическую
плоскость "XY <45" (сантехническая аксонометрия), при этом угол может быть задан
от 0 до 90 градусов считая от положительного направления оси Х против часовой стрелки.
ВНИМАНИЕ:
программа работает только для следующих типов объектов:
- линия "LINE" (правильная работа гарантируется)
- дуга "ARC"
- полилиния "LWPOLYLINE" без криволинейных сегментов
- круг "CIRCLE" (пересчет в эллипс)
- прямоугольник "RECTANGLE" (также, как и полилиния)
- многоугольник "POLYGON" (также, как и полилиния)
- текст "TEXT", "MTEXT" (перемещение без поворота)
ИСХОДНЫЕ ОБЪЕКТЫ НЕ СОХРАНЯЮТСЯ (апгрейдятся они :)

Планируется сделать пересчет для:
- фигура "SOLID"
- полоса "TRACE"
- кольцо "DONUT"
- блок "INSERT"

!!! ВСЕ ДРУГИЕ ОБЪЕКЫ БУДУТ ИГНОРИРОВАТЬСЯ !!!

ПРИМЕР:
Command: gakson
ПРОГРАММА ПЕРЕВОДА ПЛАНА В АКСОНОМЕТРИЧЕСКУЮ ПРОЕКЦИЮ.
Выберите объекты:
Select objects: Specify opposite corner: 13 found
Select objects:
Введите угол в градусах (от 0 до 90), : 60
Укажите точку поворота :
0
(к этому моменту все указанные выше объекты уже перестроены в аксонометрию)
Command:
|;

(defun C:gakson ( / *error*)
(setq p_cmdecho (getvar "CMDECHO")
p_snapmode (getvar "SNAPMODE")
p_orthomode (getvar "ORTHOMODE")
p_blipmode (getvar "BLIPMODE")
p_osmode (getvar "OSMODE")
)

(defun *error* (msg) ; Переопределение функции ERROR
(princ "Программа прервана пользователем")
(setvar "SNAPMODE" p_snapmode)
(setvar "ORTHOMODE" p_orthomode)
(setvar "BLIPMODE" p_blipmode)
(setvar "OSMODE" p_osmode)
(setvar "CMDECHO" p_cmdecho)
; (setvar "ERRNO" 0)
(setq p_cmdecho nil p_snapmode nil p_orthomode nil p_osmode nil p_blipmode nil)
; (princ "\n END with ERROR")
(princ)
) ; defun(*error*)

(setvar "CMDECHO" 0)
(setvar "SNAPMODE" 0)
(setvar "ORTHOMODE" 0)
(setvar "BLIPMODE" 0)
(setvar "OSMODE" 1)
(gc)

(setq stangle nil stangle1 nil endangle nil endangle1 nil bit10 nil bit10new nil
bit11 nil bit11new nil bit50 nil bit50new nil bit51 nil bit51new nil object_new nil)
(setq n 0 nabr nil number 0 name nil processed_obj 0)

(princ "\n2D Axonometric Conversion Programm")
(princ "\nSelect Objects")
(setq nabr (ssget))
(setq number (sslength nabr))
(initget 6)
(setq ugol (getreal "\n Enter Rotation Angle from 0-90 : "))
(if (null ugol) (setq ugol 45.0))
(setq ugolrad (* pi (/ ugol 180.0)))
(setq point (getpoint "\n Select Rotation Point : ")
x0 (car point)
y0 (cadr point)
)
(princ "\n")
(setvar "OSMODE" 0)
(while (> number n)
(setq name (ssname nabr n))
(setq object (entget name))
(setq klass (cdr (assoc 0 object)))
(if (= (cdr (assoc 70 (tblsearch "LAYER" (cdr (assoc 8 object))))) 4) ; бит 4 - слой заблокирован (проверять для каждой версии AutoCAD'a)
(vl-cmdf "_.-layer" "_U" (cdr (assoc 8 object)) "")
)
; разделение по типам объектов
(cond
;;;----- Обработка примитивов типа "LINE", пересчет координат вершин
((eq klass "LINE")
(setq bit10 (assoc 10 object)
bit11 (assoc 11 object)
x1 (cadr bit10)
y1 (caddr bit10)
z1 (cadddr bit10)
x2 (cadr bit11)
y2 (caddr bit11)
z2 (cadddr bit11)

x1n (+ (* (- y1 y0) (cos ugolrad)) x1)
y1n (+ (* (- y1 y0) (sin ugolrad)) y0)
x2n (+ (* (- y2 y0) (cos ugolrad)) x2)
y2n (+ (* (- y2 y0) (sin ugolrad)) y0)

bit10new (list 10 x1n y1n z1)
bit11new (list 11 x2n y2n z2)

object_new (subst bit10new bit10 object)
object_new (subst bit11new bit11 object_new)

processed_obj (1+ processed_obj)
)
(entmod object_new)
(entupd name)
) ; equal klass "LINE"

;;;----- Обработка примитивов типа "LWPOLYLINE", пересчет координат вершин
((eq klass "LWPOLYLINE")
(foreach item object ; выбор из описания полилинии координат вершин
(if (= (car item) 10)
(setq coords (cons item coords))
)
)
(setq vertex (length coords) num_ver 0 object_new object)
(while (> vertex num_ver)
(setq bit10 (nth num_ver coords)
x1 (cadr bit10)
y1 (caddr bit10)

x1n (+ (* (- y1 y0) (cos ugolrad)) x1)
y1n (+ (* (- y1 y0) (sin ugolrad)) y0)

bit10new (list 10 x1n y1n)

object_new (subst bit10new bit10 object_new)
)
(setq num_ver (1+ num_ver))
) ; while(vertex>num_ver)
(entmod object_new)
(entupd name)
(setq processed_obj (1+ processed_obj) coords nil vertex nil)
) ; equal klass "LWPOLYLINE"

;;;----- Обработка примитивов типа "CIRCLE", пересчет координат центра
;;; для преобразования окружности в эллипс используется коэффициенты (эмпирические):
;;; Rmin/Rmax=-0,0000000000943901414007017*ugol^4+0,000000567997308646077*ugol^3-0,0000362793934898559*ugol^2+0,00997592958744082*ugol-0,0128148277900414
;;; Rmax/Rокр=0,000000000310680082815694*ugol^4+0,00000000353048189760587*ugol^3-0,0000539963966370921*ugol^2+0,00000236411058931183*ugol+1,41420291881995
((eq klass "CIRCLE")
(setq bit8 (assoc 8 object) ; слой объекта
bit10 (assoc 10 object) ; координаты центра окружности
bit40 (assoc 40 object) ; радиус окружности
bit67 (assoc 67 object) ; пространство модель/лист
bit410 (assoc 410 object) ; имя пространства
x1 (cadr bit10)
y1 (caddr bit10)
z1 (cadddr bit10)
radius (cdr bit40)
x1n (+ (* (- y1 y0) (cos ugolrad)) x1)
y1n (+ (* (- y1 y0) (sin ugolrad)) y0)
)
(if (= ugol 45.0)
(setq radiuscoeff (/ 54.11961001 130.65629649)
Rmaxcoeff (/ 130.65629649 100.0)
)
(setq radiuscoeff (- (+ (* 0.000000567997308646077 (expt ugol 3.0)) (* 0.00997592958744082 ugol)) (* 0.0000000000943901414007017 (expt ugol 4.0)) (* 0.0000362793934898559 (expt ugol 2.0)) 0.0128148277900414)
Rmaxcoeff (- (+ (* 0.000000000310680082815694 (expt ugol 4.0)) (* 0.00000000353048189760587 (expt ugol 3.0)) (* 0.00000236411058931183 ugol) 1.41420291881995) (* 0.0000539963966370921 (expt ugol 2.0)))
)
)
(setq Xbit11 (* Rmaxcoeff radius (cos (* pi (/ ugol 360.0))))
Ybit11 (* Rmaxcoeff radius (sin (* pi (/ ugol 360.0))))
bit10new (list 10 x1n y1n z1)
bit11new (list 11 Xbit11 Ybit11 z1)
bit40new (cons 40 radiuscoeff)
bit42new (cons 42 (* pi 2.0))

processed_obj (1+ processed_obj)
)
(entmakex (list '(0 . "ELLIPSE") '(100 . "AcDbEntity") bit67 bit410 bit8
'(100 . "AcDbEllipse") bit10new bit11new '(210 0.0 0.0 1.0)
bit40new '(41 . 0.0) bit42new))
(entdel name)
) ; equal klass "CIRCLE"

;;;----- Обработка примитивов типа "ARC", пересчет координат центра и вершин
((eq klass "ARC")
(setq bit8 (assoc 8 object) ; слой объекта
bit10 (assoc 10 object) ; координаты центра дуги
bit40 (assoc 40 object) ; радиус дуги
bit50 (assoc 50 object) ; начальный угол (радианы)
bit51 (assoc 51 object) ; конечный угол (радианы)
bit67 (assoc 67 object) ; пространство модель/лист
bit410 (assoc 410 object) ; имя пространства
x1 (cadr bit10)
y1 (caddr bit10)
z1 (cadddr bit10)
radius (cdr bit40)
stangle (cdr bit50)
endangle (cdr bit51)
x1n (+ (* (- y1 y0) (cos ugolrad)) x1)
y1n (+ (* (- y1 y0) (sin ugolrad)) y0)
chetv (* pi (/ 90.0 180.0))
eighth (* pi (/ ugol 360.0))
)
(if (and (>= stangle 0.0) (= endangle 0.0) (= stangle (* pi 0.5)) (= endangle (* pi 0.5)) (= stangle pi) (= endangle pi) (= stangle (* pi 1.5)) (= endangle (* pi 1.5)) (< endangle (* pi 2.0)))
(setq endangle1 (- endangle (* (- chetv ugolrad) (- 4.0 (/ endangle chetv)))))) ; if для IV четверти

(if (= ugol 45.0)
(setq radiuscoeff (/ 54.11961001 130.65629649)
Rmaxcoeff (/ 130.65629649 100.0)
)
(setq radiuscoeff (- (+ (* 0.000000567997308646077 (expt ugol 3.0)) (* 0.00997592958744082 ugol)) (* 0.0000000000943901414007017 (expt ugol 4.0)) (* 0.0000362793934898559 (expt ugol 2.0)) 0.0128148277900414)
Rmaxcoeff (- (+ (* 0.000000000310680082815694 (expt ugol 4.0)) (* 0.00000000353048189760587 (expt ugol 3.0)) (* 0.00000236411058931183 ugol) 1.41420291881995) (* 0.0000539963966370921 (expt ugol 2.0)))
)
)
(setq Xbit11 (* Rmaxcoeff radius (cos (* pi (/ ugol 360.0))))
Ybit11 (* Rmaxcoeff radius (sin (* pi (/ ugol 360.0))))
bit10new (list 10 x1n y1n z1)
bit11new (list 11 Xbit11 Ybit11 z1)
bit40new (cons 40 radiuscoeff)
bit41new (cons 41 stangle1)
bit42new (cons 42 endangle1)

processed_obj (1+ processed_obj)
)
(entmakex (list '(0 . "ELLIPSE") '(100 . "AcDbEntity") bit67 bit410 bit8
'(100 . "AcDbEllipse") bit10new bit11new '(210 0.0 0.0 1.0)
bit40new bit41new bit42new))
(entdel name)

) ; equal klass "ARC"

;;;----- Обработка примитивов типа "*TEXT" и "POINT", пересчет координат точки вставки
((member klass '("TEXT" "MTEXT" "POINT"))
(setq bit10 (assoc 10 object)
x1 (cadr bit10)
y1 (caddr bit10)
z1 (cadddr bit10)

x1n (+ (* (- y1 y0) (cos ugolrad)) x1)
y1n (+ (* (- y1 y0) (sin ugolrad)) y0)

bit10new (list 10 x1n y1n z1)
object_new (subst bit10new bit10 object)

processed_obj (1+ processed_obj)
)
(entmod object_new)
(entupd name)
) ; member klass "*TEXT" "POINT"

) ; cond
(setq n (+ n 1))

) ;while(main)

(if (/= n processed_obj)
(princ (strcat "\nUnchanged Objects " (rtos (- n processed_obj) 2 0) ".\n"))
)
(setvar "SNAPMODE" p_snapmode)
(setvar "ORTHOMODE" p_orthomode)
(setvar "BLIPMODE" p_blipmode)
(setvar "OSMODE" p_osmode)
(setvar "CMDECHO" p_cmdecho)
; (setvar "ERRNO" 0)

)
(c:gakson)
; defun

Routine For Transforming a Block to Isometric


;;-----------------------------------------------------------------------
;;
;; Command Name - IsoBlock
;; Routine For Transforming a Block to Isometric
;; By WizMan_07Feb10
;;
;; Version 1.0 - 11May09
;; Version 1.1 - 06Feb10 - Added Reverse Option and Flatten(Express)
;; Version 1.2 - 07Feb10 - Fixed DText Rotation inside block(by SEANT)
;;
;;
;;-----------------------------------------------------------------------
;;
;;
(defun c:isob (/ blok_ent
counter ent_data
ent_pt i
sub_func *error*
blk_name midtbox
midtxt reverseflag
rot tbox
)
;;
;;--------------------------------------------------------------------
;;
(defun to_southwest (ent_name base_pt / obj)
(vla-TransformBy
(setq obj (vlax-ename->vla-object ent_name))
(vlax-tmatrix
(list
(list (/ (sqrt 2.) 2.) (- (/ (sqrt 2.) 2.)) 0. 0.)
(list (/ (sqrt (/ 2. 3.)) 2.)
(/ (sqrt (/ 2. 3.)) 2.)
(sqrt (/ 2. 3.))
0.
)
(list (- (/ (sqrt 3.) 3.))
(- (/ (sqrt 3.) 3.))
(/ (sqrt 3.) 3.)
0.
)
(list 0. 0. 0. 1.)
)
)
)
(vla-move obj
(vlax-3d-point
(trans (cdr (assoc 10 (entget ent_name))) ent_name 0)
)
(vlax-3d-point base_pt)
)
)
;;
;;--------------------------------------------------------------------
;;
(defun to_southeast (ent_name base_pt / obj)
(vla-TransformBy
(setq obj (vlax-ename->vla-object ent_name))
(vlax-tmatrix
(list
(list (/ (sqrt 2.) 2.) (/ (sqrt 2.) 2.) 0. 0.)
(list (- (/ (sqrt (/ 2. 3.)) 2.))
(/ (sqrt (/ 2. 3.)) 2.)
(sqrt (/ 2. 3.))
0.
)
(list (/ (sqrt 3.) 3.)
(- (/ (sqrt 3.) 3.))
(/ (sqrt 3.) 3.)
0.
)
(list 0. 0. 0. 1.)
)
)
)
(vla-move obj
(vlax-3d-point
(trans (cdr (assoc 10 (entget ent_name))) ent_name 0)
)
(vlax-3d-point base_pt)
)
)
;;
;;--------------------------------------------------------------------
;;
(defun to_front (ent_name base_pt / obj)
(vla-TransformBy
(setq obj (vlax-ename->vla-object ent_name))
(vlax-tmatrix
(list
(list 1. 0. 0. 0.)
(list 0. 0. 1. 0.)
(list 0. 1. 0. 0.) ;mirrored
(list 0. 0. 0. 1.)
)
)
)
(vla-move obj
(vlax-3d-point
(trans (cdr (assoc 10 (entget ent_name))) ent_name 0)
)
(vlax-3d-point base_pt)
)
)
;;
;;--------------------------------------------------------------------
;;
(defun to_front_southwest (ent_name base_pt / obj)
(to_front ent_name base_pt)
(to_southwest ent_name base_pt)
)
;;
;;--------------------------------------------------------------------
;;
(defun to_front_southeast (ent_name base_pt / obj)
(to_front ent_name base_pt)
(to_southeast ent_name base_pt)
)
;;
;;--------------------------------------------------------------------
;;
(defun dtr (var)
(* PI (/ var 180.0))
)
;;
;;--------------------------------------------------------------------
;;
(defun fix_txt (blk oblang / ins)
(vlax-for
obj
(vla-item (vla-get-Blocks doc) (cdr (assoc 2 (entget blk))))

(if (eq "AcDbText" (vla-get-Objectname obj))
(progn
(Setq ins (vlax-get obj 'insertionpoint))
(vla-put-upsidedown obj 0)
(vla-put-ObliqueAngle obj (dtr oblang))
(vlax-put obj 'insertionpoint ins)
(vla-update (vlax-ename->vla-object (entlast)))
)
)
)
)
;;
;;--------------------------------------------------------------------
;;
(defun *error* (msg)
(if blok_ent
(progn
(load "flattensup.lsp")
(acet-flatn (ssadd blok_ent (ssadd)) nil)
(cond ((= sub_func (quote to_front_southwest))
(fix_txt (entlast) 30)
)
((= sub_func (quote to_front_southeast))
(fix_txt (entlast) 330)
)
(t nil)
)
(if reverseflag
(vlax-for
obj
(vla-item (vla-get-Blocks doc) blk_name)

(if (eq "AcDbText" (vla-get-Objectname obj))
(vla-rotate obj (vlax-3d-point midtxt) pi)
)
)
)
(setq reverseflag nil)
)
)
(and doc (vla-endundomark doc))
(setvar 'cmdecho 1)
)
;;
;;--------------------------------------------------------------------
;;
(setq doc (vla-get-activedocument
(vlax-get-acad-object)
)
)
(vla-EndUndoMark doc)
(vla-StartUndoMark doc)
(setvar 'cmdecho 0)
;;
;;--------------------------------------------------------------------
;;
(if (setq blok_ent (car (entsel "\n>>>...Pick a block...>>>: ")))
(progn
(setq ent_data (entget blok_ent))
(setq ent_pt (cdr (assoc 10 ent_data)))
(setq blk_name (cdr (assoc 2 ent_data)))
(to_southwest blok_ent ent_pt)

(setq counter 1)
(while (or (= (setq i (strcase
(getstring
"\rPress [SpaceBar] to Toggle View, [R]everse or Press [Q] to exit: "
)
)
)
""
)
(= i "R")

)
(if (/= i "R")
(progn
(if blok_ent
(vla-delete (vlax-ename->vla-object blok_ent))
)
(setq sub_func
(nth counter
'(to_southwest
to_southeast
to_front_southwest
to_front_southeast
)
)
)
(entmake ent_data)
(setq blok_ent (entlast))

(if reverseflag
(vlax-for
obj
(vla-item (vla-get-Blocks doc)
(cdr (assoc 2 (entget blok_ent)))
)

(if (eq "AcDbText" (vla-get-Objectname obj))
(progn
(vla-rotate obj (vlax-3d-point midtxt) pi)
(vla-update (vlax-ename->vla-object blok_ent))
)
)
)
)

((eval sub_func) blok_ent ent_pt)
(if (vla-object blok_ent)))
(vla-put-rotation
(vlax-ename->vla-object blok_ent)
(+ rot pi)
)
(vlax-for
obj
(vla-item (vla-get-Blocks doc) (cdr (assoc 2 (entget blok_ent))))

(if (eq "AcDbText" (vla-get-Objectname obj))
(progn
(setq ins (vlax-get obj 'insertionpoint))
(setq tbox (textbox (entget (vlax-vla-object->ename obj))))
(setq midtbox (mapcar '/
(mapcar '+ (car tbox) (cadr tbox))
'(2. 2. 2.)
)
)
(setq midtxt (mapcar '+ ins midtbox))
(vla-rotate obj (vlax-3d-point midtxt) pi)
(vla-update (vlax-ename->vla-object blok_ent))
)
)
)
)
)
)
)

)
)
(*error* "")
(princ)
)
(vl-load-com)
(command "highlight" "1")
;;
;;--------------------------------------------------------------------
;;
(prompt
"\n>>>...IsoBlock.lsp is now loaded. Type 'IsoB' to start ...<<<"
) ;_ prompt
(princ)
;;--------------------------------------------------------------------
;;
;;
;;WIZ_07FEB10
(c:isob)
(command "highlight" "1")