Sep 11, 2011

Convert Text into Isometric in AutoCAD (Snippet)

This is not a tutorial but a code snippet which helps you convert text in autocad to be isometric view in flat surface which looks like this:





The best and fastest way to make an iso text is to make it 3D, extrude it and it's done.

But here is a code to simply change the text position.

The code is not mine:


; copyright 1987 by looking glass microproducts

;---------------------------------------------------------------------------
; COMPUTE ISOPOINT
(defun isopoint ( p1 )
(list (+ (* (car p1) cos_ax)
(* (cadr p1) cos_ay)
xbase
)
(+ (* (car p1) sin_ax)
(* (cadr p1) sin_ay)
ybase
)
)

)
(princ ".")
;---------------------------------------------------------------------------
; set the current layer, linetype, and color to that of a specified
; entity
; globals -- olayer, ocolor, oltype -- old layer, color, and linetype
;
(defun lset (ent / layer ltype color)

(setq
ltype (cdr (assoc 6 ent))
layer (cdr (assoc 8 ent))
color (cdr (assoc 62 ent))
)
(if (null ltype) (setq ltype "BYLAYER"))
(cond ((null color) (setq color "BYLAYER"))
((= 0 color) (setq color "BYBLOCK"))
)

(if (/= layer olayer)
(command "layer" "set" (setq olayer layer) "")
)

(if (/= ltype oltype)
(command "linetype" "set" (setq oltype ltype) "")
)

(if (/= color ocolor)
(command "color" (setq ocolor color))
)
)

(princ ".")
;---------------------------------------------------------------------------
; save the current layer, color, linetype, elevation, and thickness
; globals -- savlayer, savltype, savcolor, savelev, savthik
;
(defun savelayr ()
(setq savlayer (getvar "clayer")
savltype (getvar "celtype")
savcolor (getvar "cecolor")
savelev (getvar "elevation")
savthik (getvar "thickness")
)

(if (and (/= savcolor "BYLAYER")
(/= savcolor "BYBLOCK")
)
(setq savcolor (atoi savcolor))
)
(setvar "elevation" 0.0)
(setvar "thickness" 0.0)
)
(princ ".")
;---------------------------------------------------------------------------
; restore the current layer, color, linetype, elevation, and thickness
; globals -- savlayer, savltype, savcolor, savelev, savthik
;
(defun rlayer()
(setvar "elevation" savelev)
(setvar "thickness" savthik)
(command "linetype" "set" savltype ""
"layer" "set" savlayer ""
"color" savcolor
)
)
(princ ".")
(defun modent ( ent )
(entmod
(subst
'(39 . 0.0)
(assoc 39 (setq ent
(subst
'(38 . 0.0)
(assoc 38 ent)
ent
)
)
)
ent
)
)
)
(princ ".")
;---------------------------------------------------------------------------
; convert a text entity to isometric
;
(defun isotext ( ent / inspnt-i inspnt-l inspnt-il
alipnt-i alipnt-l alipnt-il
xpnt-i xfactor xfact-l xfact-il
rotate rotate-i rotate-il
height-l height-il
oblique-i oblique-il
)


(setq inspnt-il ; insertion point
(cons 10
(setq inspnt-i
(isopoint
(setq inspnt (cdr (setq inspnt-l (assoc 10 ent)
)
)
)
)
)
)
)

(setq alipnt-il ; alignment point
(cons 11
(IF (setq alipnt
(cdr
(setq alipnt-l (assoc 11 ent)
)
)
)
(isopoint alipnt)
)
)
)
(setq rotate
(cdr
(setq rotate-l (assoc 50 ent)
)
)
)

(setq raw-h
(distance inspnt-i
(setq hpnt-i
(isopoint
(polar inspnt (+ rotate half-pi)
(cdr
(setq height-l (assoc 40 ent)
)
)
)
)
)
)
)



(setq raw-x
(distance inspnt-i
(setq xpnt-i
(isopoint
(polar inspnt
rotate
(setq xfactor
(cdr
(setq xfact-l (assoc 41 ent)
)
)
)
)
)
)
)
)

(setq height-il ; height
(cons 40
(setq real-h
(* raw-h
(cos
(-
(angle inspnt-i hpnt-i)
(angle inspnt-i xpnt-i)
half-pi
)
)
)
)
)
)
(setq xfact-il ; width factor
(cons 41
(* (/ (cdr height-l) (cdr height-il))
raw-x
)
)

)
(setq rotate-il ; rotation angle
(cons 50
(setq rotate-i
(angle inspnt-i xpnt-i
)
)
)
)

(setq oblique-il ; obliquing angle
(cons 51
(- (+ half-pi rotate-i)
(angle inspnt-i
(isopoint
(polar inspnt
(- (+ rotate half-pi)
(cdr
(setq oblique-l
(assoc 51 ent)
)
)
)
1.0
)
)
)
)
)
)
(modent ; make the substitutions
(subst inspnt-il inspnt-l
(subst alipnt-il alipnt-l
(subst height-il height-l
(subst xfact-il xfact-l
(subst rotate-il rotate-l
(subst oblique-il oblique-l ent)
)
)
)
)
)
)
)
(princ ".")
;---------------------------------------------------------------------------
; convert a specified subentity to isometric
;
(defun update (ent num / p)

(subst
(cons num
(isopoint
(cdr
(setq p (assoc num ent)
)
)
)
)
p
ent
)
)

(princ ".")
;---------------------------------------------------------------------------
; convert a line entity to isometric
;
(defun isoline ( ent )
(modent
(update
(update ent 10)
11
)
)
)

(princ ".")
;---------------------------------------------------------------------------
; convert a solid entity to isometric
;
(defun isosolid ( ent )
(modent
(update
(update
(update
(update ent 10)
11
)
12
)
13
)
)
)

(princ ".")
;---------------------------------------------------------------------------
; convert a point entity to isometric
;

(defun ipoint (ent )
(modent
(update ent 10)
)
)


(princ ".")

;---------------------------------------------------------------------------
; return the (sign of test) X value
;

(defun sgn (test value)
(cond ((minusp test) (- value))
((zerop test) 0 )
( T value )
)
)

(princ ".")

;---------------------------------------------------------------------------
; compute the sub-arcs of an isoarc
;
; c -- center point
; r -- radius
; ac0 -- angle from c to p0
; ac1 -- angle from c to p1
; angle -- included angle in arc
;
(defun do-isoarc (c r ac0 ac1 p0 p1 ang / da nseg s0 a0 da2)
(if (/= 0.0 ang)
(progn
(setq
da (sgn ang delta)
nseg (min nsegs
(max 1
(fix (/ ang da))
)
)
da (/ ang (* 2.0 nseg))
s0 (* 2.0 r (abs (sin (* 0.5 da))))
a0 (+ ac0 (* 0.5 (+ pi da)))
da2 (+ da da)

)
(repeat nseg
(command "S"
(isopoint (setq p0 (polar p0 a0 s0)))
(isopoint (setq p0 (polar p0 (+ a0 da) s0)))
)
(setq a0 (+ a0 da2))
)
)
)
)

(princ ".")
;---------------------------------------------------------------------------
; convert an arc entity to isometric
;
(defun isoarc ( ent ename / c r ac0 ac1 p0 p1 ang )
(lset ent)
(redraw ename 2)
(setq p0 (polar
(setq c
(cdr (assoc 10 ent))
)
(setq ac0
(cdr (assoc 50 ent))
)
(setq r
(cdr (assoc 40 ent))
)
)
p1 (polar
c
(setq ac1
(cdr (assoc 51 ent))
)
r
)
ang (- ac1 ac0)

)
(if (minusp ang)
(setq ang (+ ang (* pi 2.0)))
)
(command "Pline" (isopoint p0) "w" "0.0" "0.0" "ARC")

(do-isoarc c r ac0 ac1 p0 p1 ang)
(command "")
(entdel ename)
)

(princ ".")
;---------------------------------------------------------------------------
; convert an circle entity to isometric
;
(defun isocirc ( ent ename / c r ac0 p0 )
(lset ent)
(redraw ename 2)

(setq c (cdr (assoc 10 ent))
r (cdr (assoc 40 ent))
ac0 0.0
p0 (polar c ac0 r)
)
(command "Pline" (isopoint p0) "w" "0.0" "0.0" "ARC")
(do-isoarc c r ac0 ac0 p0 p0 (* 2.0 pi))
(command "CLOSE")
(entdel ename)
)

(princ ".")
;---------------------------------------------------------------------------
; convert an polyline entity to isometric
;

(defun isopoly ( ent ename / whole closed bulge p0 p1 d01 ang
a01 a1c r c ac0 ac1 firstp)
(lset ent)
(redraw ename 2)
(command "Pline" )
(setq
whole ename
closed (/= 0 (logand 1 (cdr (assoc 70 ent))))
bulge 0.0
)
(while
(= "VERTEX"
(cdr (assoc 0
(setq ent (entget
(setq ename (entnext ename))
)
)
)
)
)

(setq p1 (cdr (assoc 10 ent)))

(if (zerop bulge)
(progn
(command (isopoint (setq p0 p1) ) ); not the end of an arc
(if (null firstp)
(progn
(setq firstp p1)
(command "w" "0.0" "0.0")
)
)
(if (/= 0.0 (setq bulge (cdr (assoc 42 ent))))
(command "ARC")
)
)
(progn ; the end of an arc
; find the center of the arc
(setq d01 (distance p0 p1)
ang (* 4.0 (atan bulge))
a01 (angle p0 p1)
a1c (* 0.5 (- pi ang))
r (/ (* 0.5 d01) (cos a1c))
c (polar p0 (+ a1c a01) r)
ac0 (angle c p0)
ac1 (angle c p1)
)
(do-isoarc c r ac0 ac1 p0 p1 ang)
(setq p0 p1)
(if (zerop (setq bulge (cdr (assoc 42 ent))))
(command "LINE")
)
)
) ; end of if bulge

) ; end of while


(if closed
(progn

(if (/= 0.0 bulge)
(progn ; the end of an arc
; find the center of the arc
(setq p1 firstp)
(setq d01 (distance p0 p1)
ang (* 4.0 (atan bulge))
a01 (angle p0 p1)
a1c (* 0.5 (- pi ang))
r (/ (* 0.5 d01) (cos a1c))
c (polar p0 (+ a1c a01) r)
ac0 (angle c p0)
ac1 (angle c p1)
)
(do-isoarc c r ac0 ac1 p0 p1 ang)
(setq p0 p1)
)
) ; end of if bulge
(command "CLOSE")
)
(command "")
)
(entdel whole)
)

(princ ".")

;---------------------------------------------------------------------------
; return the current isoplane
;

(defun setplane ( / isoplane prmpt newplane)
(setq isoplane (getvar "snapisopair"))
(while (null newplane)

;update prompt & isoplane to account for toggles
(setq prmpt
(strcat
"\nSelect isoplane "
(cond ( (= 0 isoplane) ; left
"/Top/Right: "
)
( (= 1 isoplane) ; top
"Left//Right: "
)
( (= 2 isoplane) ; right
"Left/Top/: "
)
)
)
)


(setq
reply
(strcase
(substr (getstring prmpt) 1 1)
)
)

(setq
isoplane
(getvar "snapisopair") ; check for toggles

newplane
(cond
( (= "L" reply) 0)
( (= "T" reply) 1)
( (= "R" reply) 2)
( (= "" reply) isoplane)
)
)
)

(setvar "snapisopair"
newplane
)
)
(princ ".")
;---------------------------------------------------------------------------
; this is the body of the ISO function
;
(defun c:iso ( / ax ay ce bm closed ent ename e isoplane
olayer oltype ocolor savlayer savltype savcolor
ibase xbase ybase half-pi nsegs delta l
sin_ax sin_ay cos_ax cos_ay olayer oltype ocolor
not_done savthik savelev
)
(setq p (ssget))
(if p (progn
(while (null (setq ibase (getpoint "Base point: ")))
)
(setq isoplane (setplane))

(savelayr)
(terpri)

(cond ( (= 0 isoplane) ; left
(setq ax (/ (* 11.0 pi) 6.0)
ay (/ pi 2.0)
)
)
( (= 1 isoplane) ; top
(setq ax (/ (* 11.0 pi) 6.0)
ay (/ pi 6.0)
)
)
( (= 2 isoplane) ; right
(setq ax (/ pi 6.0)
ay (/ pi 2.0)
)
)
)
(setq
sin_ax (sin ax)
cos_ax (cos ax)
sin_ay (sin ay)
cos_ay (cos ay)
xbase (- (car ibase)
(* cos_ax (car ibase))
(* cos_ay (cadr ibase))
)
ybase (- (cadr ibase)
(* sin_ax (car ibase))
(* sin_ay (cadr ibase))
)
half-pi (* 0.5 pi)
nsegs 18
delta (/ (* 2.0 pi) nsegs)
ce (getvar "cmdecho")
bm (getvar "blipmode")
l 0
n (sslength p)
not_done 0
)
(setvar "cmdecho" 0)
(setvar "blipmode" 0)

; main loop
(while (< l n) (setq enttype (cdr (assoc 0 (setq ent (entget (setq ename (ssname p l)))) ) ) l (1+ l) ) (cond ((= "POLYLINE" enttype) (isopoly ent ename)) ((= "LINE" enttype) (isoline ent )) ((= "POINT" enttype) (ipoint ent )) ((= "ARC" enttype) (isoarc ent ename)) ((= "CIRCLE" enttype) (isocirc ent ename)) ((= "SOLID" enttype) (isosolid ent )) ((= "TEXT" enttype) (isotext ent )) ((= "SHAPE" enttype) (isotext ent )) ((= "ATTDEF" enttype) (isotext ent )) (T (setq not_done (1+ not_done))) ) ) ; end of the while (rlayer) (command "REDRAW") (setvar "cmdecho" ce) (setvar "blipmode" bm) (cond ((= not_done 1) (princ "\n[WARNING -- One Entity was NOT Converted") ) ((> not_done 1)
(princ (strcat
"\n[WARNING -- "
(itoa not_done)
" Entities were NOT Converted"
)
)
)

(T (princ "\n[Done"))
)
)
(princ "\n[None selected")
) ; end of if p
']
)
(princ
"\n[IsoCAD Version 1.43 -- Copyright 1987 by Looking Glass Microproducts]")

(c:iso)





No comments:

Post a Comment