• Add-On’s
  • Download
  • History of AutoLISP
  • Lisp Resources
  • Run an AutoLISP

LispBox

~ This blog was initially created for people, who love autolisp routines, as I love it.

Category Archives: Isometric

Isometric Add Ons

Marko Ribar Dynamic ISOmetric Routine

12 Sunday Feb 2017

Posted by danglar71 in 3D, Isometric

≈ Leave a comment


;;; 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)

Axonometric Planes Creator through dynamic rectangles

14 Monday Nov 2016

Posted by danglar71 in Isometric, Lisp Collection 2014

≈ Leave a comment


;;; 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

17 Tuesday Feb 2015

Posted by danglar71 in Isometric, Text

≈ Leave a comment

;; 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

25 Tuesday Nov 2014

Posted by danglar71 in Isometric, Lisp Collection 2014

≈ Leave a comment

;|
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

25 Tuesday Nov 2014

Posted by danglar71 in Isometric, Lisp Collection 2014

≈ Leave a comment


;;-----------------------------------------------------------------------
;;
;; 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")

Recent Posts

  • Это наша плата за трусость
  • Set the Default Application to open DWG Files
  • Draw “Heat Grid” (Lee Mac)
  • PROGRAM FOR SPRINKLER DISTRIBUTION
  • How to remove Frames around blocks

Recent Comments

Wilmer Lacayo on Draw Centroid (center of gravi…
Jun on Convert Polylines to Leaders i…
Adel on HVAC Draw Branch Duct
danglar71 on Draw “Heat Grid” (…
IOAN VLAD on Draw “Heat Grid” (…

Archives

  • January 2021
  • March 2020
  • February 2020
  • January 2020
  • October 2019
  • September 2019
  • August 2019
  • July 2019
  • June 2019
  • May 2019
  • April 2019
  • February 2019
  • January 2019
  • December 2018
  • November 2018
  • October 2018
  • September 2018
  • August 2018
  • July 2018
  • June 2018
  • April 2018
  • March 2018
  • February 2018
  • January 2018
  • December 2017
  • November 2017
  • August 2017
  • July 2017
  • June 2017
  • May 2017
  • April 2017
  • March 2017
  • February 2017
  • January 2017
  • December 2016
  • November 2016
  • October 2016
  • September 2016
  • August 2016
  • July 2016
  • June 2016
  • May 2016
  • April 2016
  • March 2016
  • February 2016
  • January 2016
  • December 2015
  • November 2015
  • October 2015
  • September 2015
  • August 2015
  • July 2015
  • June 2015
  • May 2015
  • April 2015
  • March 2015
  • February 2015
  • January 2015
  • December 2014
  • November 2014

Categories

  • 3D
  • Annonymous Blocks
  • Attribute
  • Batch
  • Blocks
  • Books
  • Common
  • Coordinates
  • Counting
  • dimmensions
  • draw
  • Export
  • Fractal
  • Hatch
  • HVAC
  • Images
  • Import
  • Info
  • Isometric
  • Layers
  • Layouts
  • Lisp Collection 2014
  • Mline
  • Pdf
  • Pipes
  • plot
  • Points
  • Protect
  • Text
  • Tips (English)
  • Tips (Russian)
  • ucs
  • Utilites
  • view
  • Vport
  • Xref

Recent Posts

  • Это наша плата за трусость
  • Set the Default Application to open DWG Files
  • Draw “Heat Grid” (Lee Mac)
  • PROGRAM FOR SPRINKLER DISTRIBUTION
  • How to remove Frames around blocks

Recent Comments

Wilmer Lacayo on Draw Centroid (center of gravi…
Jun on Convert Polylines to Leaders i…
Adel on HVAC Draw Branch Duct
danglar71 on Draw “Heat Grid” (…
IOAN VLAD on Draw “Heat Grid” (…

Archives

  • January 2021
  • March 2020
  • February 2020
  • January 2020
  • October 2019
  • September 2019
  • August 2019
  • July 2019
  • June 2019
  • May 2019
  • April 2019
  • February 2019
  • January 2019
  • December 2018
  • November 2018
  • October 2018
  • September 2018
  • August 2018
  • July 2018
  • June 2018
  • April 2018
  • March 2018
  • February 2018
  • January 2018
  • December 2017
  • November 2017
  • August 2017
  • July 2017
  • June 2017
  • May 2017
  • April 2017
  • March 2017
  • February 2017
  • January 2017
  • December 2016
  • November 2016
  • October 2016
  • September 2016
  • August 2016
  • July 2016
  • June 2016
  • May 2016
  • April 2016
  • March 2016
  • February 2016
  • January 2016
  • December 2015
  • November 2015
  • October 2015
  • September 2015
  • August 2015
  • July 2015
  • June 2015
  • May 2015
  • April 2015
  • March 2015
  • February 2015
  • January 2015
  • December 2014
  • November 2014

Categories

  • 3D
  • Annonymous Blocks
  • Attribute
  • Batch
  • Blocks
  • Books
  • Common
  • Coordinates
  • Counting
  • dimmensions
  • draw
  • Export
  • Fractal
  • Hatch
  • HVAC
  • Images
  • Import
  • Info
  • Isometric
  • Layers
  • Layouts
  • Lisp Collection 2014
  • Mline
  • Pdf
  • Pipes
  • plot
  • Points
  • Protect
  • Text
  • Tips (English)
  • Tips (Russian)
  • ucs
  • Utilites
  • view
  • Vport
  • Xref

Blog at WordPress.com.

Privacy & Cookies: This site uses cookies. By continuing to use this website, you agree to their use.
To find out more, including how to control cookies, see here: Cookie Policy