This routine creates a standard isometric view from selected objects.
I would like to eliminate the prompt asking on which layer to put the selected entities as well as improve upon the placement of the iso view. We are never sure where in the drawing the new items will show up.
Using ACAD2002.
Thanks
; ISO.LSP
; Converts Arcs,Circles,Lines,Solids & Text To
; Isometric Views. Polylines,Blocks & Dims.
; Must Be Exploded First
;***** Define New Error Handling Routine
(DEFUN *error* (msg / )
(PRINC "error: ")
(PRINC MSG) ;Print Error Message To Screen
(TERPRI) ;LineFeed
(SHUTDOWN) ;Make Sure Everything Is Set To Original Values
)
;**** Define Routine To Setup Initial Variable Settings
(DEFUN SETUP ()
(SETQ NL 0 ; Number Of Lines Redrawn
NC 0 ; Number Of Circles Redrawn
NA 0 ; Number Of Arcs Redrawn
NS 0 ; Number Of Solid Redrawn
NT 0 ; Number Of Text Redrawn
O 0 ; Number Of Other Entities
NewSet (SSadd) ; Make Empty Selection Set
Blip (GETVAR "BlipMode") ; Save Initial Setting In Blip
STxt (GETVAR "TextStyle"); Save Initial Setting In STxt
Snap (GETVAR "OSMode") ; Save Initial Setting In STxt
)
(SETVAR "CmdEcho" 0) ; Turn COMMAND Echo Off
(SETVAR "BlipMode" 0) ; Turn BLIPMODE Off
(SETVAR "OSMode" 0) ; Turn OSNAPS To NONE
(COMMAND "-LAYER" "S" "DWG" "" "")
;***** If MoveToLayer Hasn't Been Set,
; Set Default to Dwg
(IF (NOT MoveToLayer)(SETQ MoveToLayer "Dwg"))
;***** If Iso_View Hasn't Been Set, Set It To Right View
(IF (NOT Iso_View)(SETQ Iso_View "R"))
;***** If Thickness Hasn't Been Set, Set Default To 0
(IF (NOT Thickness)(SETQ Thickness 0.0))
)
;***** Setup Layer Information
(DEFUN Setup_Layer ( / Ans)
;***** Get Information On Which Layer To Put
; Original Entities
(SETQ Ans (GETSTRING
(STRCAT
"\nWhich Layer To Put Original Entities On?<"
MoveToLayer
">"
)
)
)
(IF (= Ans "")(SETQ Ans MoveToLayer))
(SETQ MoveToLayer Ans)
(IF (NOT (TBLSEARCH "LAYER" MoveToLayer))
; Does The Layer Exist?
(COMMAND "-LAYER" "N" MoveToLayer "")
; Doesn't Exist, Create!
)
;***** Get Information On Whether To Give
; View A Thickness Or Not
(SETQ Ans (GETREAL (STRCAT
"\nEnter Thickness Of View <"
(RTOS Thickness)
">"
)
)
)
(IF (= Ans NIL)(SETQ Ans Thickness))
(SETQ Thickness Ans)
)
;***** Get Entitiy Selection Set From User
(DEFUN GET_ENTITIES ( / Base_Point)
(PROMPT
"\nArcs,Circles,Lines,Solids & Text Will Be Processed!!")
(PROMPT
"\nPlease Select Entities To Change To Isometric....")
(SETQ SELSET (SSGET));Get Selection Set From User
(SETQ
Base_Point (GETPOINT
"\nPick A BasePoint For The Iso Figure:(Lower Left-Hand Corner)")
BPX (CAR Base_Point) ; Extract X Value From Base Point
BPY (CADR Base_Point) ; Extract Y Value From Base Point
)
)
;***** Ask User Which Isometric View Should Be Used
(DEFUN Which_View ( / Ans)
(TERPRI) ; Print Blank Line
(INITGET "L R TR") ; Choices = Left,Right,Top R and Nil
(SETQ Ans (GETKWORD ; Get Answer From User
(STRCAT
"Which Isometric View? : "
"L-Left;R-Right;TR-Top Right <"
Iso_View
">"
)
)
)
(IF (= Ans NIL)(SETQ Ans Iso_View))
(SETQ Iso_View Ans)
;***** Set Up Depths For Creating Thicknesses
(SETQ DepthAngle 270)
(If (= Iso_View "R")(SETQ DepthAngle 150))
(If (= Iso_View "L")(SETQ DepthAngle 30))
(SETQ Depth (STRCAT "@" (RTOS Thickness) "<" (RTOS DepthAngle)))
)
;***** Pick Out Entities From Selection Set And Change To Iso
(DEFUN Change_To_Iso ( / EntName EntData EntType SL Index Flag)
(PROMPT "\nWorking.....\n\n")
; Copy Original To Specified Layer If Different
; From Current Layer
(IF (/= MoveToLayer (GETVAR "CLAYER"))
(COMMAND "CHANGE" SelSet "" "P" "Layer" MoveToLayer "")
)
(SETQ SL (SSLENGTH SelSet)) ; Get Length Of Sel. Set
(SETQ Index 0) ; Set Index to 0
(WHILE (< Index SL) ; Loop Until End Of SelSet
(SETQ FLAG 0)
(SETQ EntName (SSNAME SelSet Index)) ; Get Indexed Entity Name
(SETQ EntData (ENTGET EntName)) ; Get Entity Data
(SETQ EntType (CDR (ASSOC 0 EntData))) ; Extract Type
;***** Check For Entity Types And Call Proper Routine
(IF (= EntType "LINE")(Line_Extract_Draw))
(IF (= EntType "CIRCLE")(Circle_Extract_Draw))
(IF (= EntType "ARC")(Arc_Extract_Draw))
(IF (= EntType "TEXT")(Text_Extract_Draw))
(IF (= EntType "SOLID")(Solid_Extract_Draw))
(IF (= FLAG 0)
(PROGN
(PROMPT
"\nBlocks, Dimensions & PolyLines Must Be Exploded!")
(PROMPT "\nWorking.....")
(SETQ O (+ O 1)) ; Increment Other Count
)
)
(SETQ Index (+ Index 1)) ; Increment Index
)
;*************************
; IF There is A Thickness Copy Entities To Show Thickness
(IF (> Thickness 0)
(COMMAND "COPY" NewSet "" "0,0" Depth)
)
)
;Define Routine To Extract Data From Entities Then Draw Entity
;***** In Isometric View! -- ARC
(DEFUN ARC_Extract_Draw ( / Center Radius StartAng EndAng
First Second PickOne PickTwo Temp Temp1 TrimLines )
(SETQ NA (+ NA 1) ; One More Is Processed!
FLAG 1
)
(SETQ Center (CDR (ASSOC '10 EntData)) ; Center Of Arc
Radius (CDR (ASSOC '40 EntData)) ; Radius of Arc
StartAng (CDR (ASSOC '50 EntData)); Starting Angle
EndAng (CDR (ASSOC '51 EntData)) ; Ending Angle
)
;***** Calculate Trim Line End Points!
(SETQ First (POLAR Center StartAng (* 1.2 Radius)))
(Calc_Point First)(SETQ First New_Point)
(SETQ Second (POLAR Center EndAng (* 1.2 Radius)))
(Calc_Point Second)(SETQ Second New_POINT)
;***** Calculate Trim Pick Points!
(SETQ PickOne (POLAR Center (- StartAng (DTR 10)) Radius))
(Calc_Point PickOne)(SETQ PickOne New_Point)
(SETQ PickTwo (POLAR Center (+ EndAng (DTR 10)) Radius))
(Calc_Point PickTwo)(SETQ PickTwo New_Point)
;***** Calculate Isometric Center Point
(Calc_Point Center)(Setq Center New_Point)
(SETQ Temp (GETVAR "SnapIsoPair")) ; Get Initial Iso Vars.
(SETQ Temp1 (GETVAR "SnapStyl"))
(SETVAR "SnapStyl" 1) ; Set To Isometric
;***** Set To Proper View
(IF (= Iso_View "L")(SETVAR "SnapIsoPair" 0))
(IF (= Iso_View "TR")(SETVAR "SnapIsoPair" 1))
(IF (= Iso_View "R")(SETVAR "SnapIsoPair" 2))
(COMMAND "ELLIPSE" "I" Center Radius) ; Draw Iso-Circle
(SETVAR "SnapIsoPair" Temp) ; Revert To Original
(SETVAR "SnapStyl" Temp1) ; Isometric Values
(COMMAND "PLINE" First Center Second "") ; Draw Trim Lines
(SETQ TrimLines (ENTLAST))
(COMMAND "TRIM" TrimLines "" PickOne PickTwo "") Trim Circle
(SETQ NewSet (SSADD (ENTLAST) NewSet)) ; Add It To NewSet
(COMMAND "ERASE" TrimLines "") ; Erase Trim Lines
(PROMPT "\nWorking.....\n\n")
)
;**** Define Routine To Extract Data From Entities
; Then Draw Entity
;**** In Isometric View! -- LINE
(DEFUN Line_Extract_Draw ( / Start End)
(SETQ NL (+ NL 1)) ; One More Line Is Processed!
(SETQ FLAG 1)
(SETQ Start (CDR (ASSOC 10 EntDATA)) ; Extract Start Point
End (CDR (ASSOC 11 EntDATA)) ; Extract End Point
)
;********** Recalculate Start Point
(Calc_Point Start)
(SETQ Start New_Point)
;********** Recalculate End Point
(Calc_Point End)
(SETQ End New_Point)
;********** Draw New Line In Isometric
(COMMAND "LINE" Start End "")
(SETQ NewSet (SSADD (ENTLAST) NewSet)) ; Add It To NewSet
;********** Add Depth Thickness Line If Thickness Is Set
(IF (> Thickness 0)
(PROGN
(COMMAND "LINE" Start Depth "")
(COMMAND "LINE" End Depth "")
)
)
)
;***** Define Routine To Extract Data From Entities
; Then Draw Entity
;***** In Isometric View! -- CIRCLE
(DEFUN Circle_Extract_Draw ( / Temp Temp1 Center Radius Ang Cen
L1 L2 Depth1 Depth2 PP1 PP2)
(SETQ NC (+ NC 1)) ; One More Processed!
(SETQ FLAG 1)
(SETQ Center (CDR (ASSOC '10 EntData)) ; Get Center Point
Cen Center ; Store It Also In Cen
Radius (CDR (ASSOC '40 EntData)) ; Get Circle Radius
)
(Calc_Point Center)(SETQ Center New_Point)
; Calculate New Center
(SETQ Temp (GETVAR "SnapIsoPair"))
(SETQ Temp1 (GETVAR "SnapStyl"))
(SETVAR "SnapStyl" 1) ; Set To Isometric Grid
(IF (= Iso_View "L") ; Set To Proper View, Top,Left Or Right
(SETVAR "SnapIsoPair" 0)
)
(IF (= Iso_View "TR")
(SETVAR "SnapIsoPair" 1)
)
(IF (= Iso_View "R")
(SETVAR "SnapIsoPair" 2)
)
(COMMAND "ELLIPSE" "I" Center Radius)
(SETQ Circle (ENTLAST))
;***** If Thickness Set, Draw Depth Lines
(IF (/= Thickness 0)
(PROGN
(IF (= Iso_View "R")(SETQ LineAng1 45
LineAng2 225
TrimAng1 40
TrimAng2 230
)
)
(IF (= Iso_View "L")(SETQ LineAng1 135
LineAng2 315
TrimAng1 140
TrimAng2 310
)
)
(IF (= Iso_View "TR")(SETQ LineAng1 135
LineAng2 315
TrimAng1 130
TrimAng2 320
)
)
(SETQ Depth1 (POLAR Cen (DTR LineAng1) Radius))
(Calc_Point Depth1)(SETQ Depth1 New_Point)
(SETQ Depth2 (POLAR Cen (DTR LineAng2) Radius))
(Calc_Point Depth2)(SETQ Depth2 New_Point)
(COMMAND "LINE" Depth1 Depth "")(SETQ L1 (ENTLAST))
(COMMAND "LINE" Depth2 Depth "")(SETQ L2 (ENTLAST))
(COMMAND "COPY" Circle "" "0,0" Depth)
(SETQ PP1 (POLAR Cen (DTR TrimAng1) Radius))
(Calc_Point PP1)(SETQ PP1 New_Point)
(SETQ PP2 (POLAR Cen (DTR TrimAng2) Radius))
(Calc_Point PP2)(SETQ PP2 New_Point)
(SETQ PP1 (POLAR PP1 (DTR DepthAngle) Thickness))
(SETQ PP2 (POLAR PP2 (DTR DepthAngle) Thickness))
(COMMAND "TRIM" L1 L2 "" PP1 PP2 "")
)
)
(SETVAR "SnapIsoPair" Temp)
(SETVAR "SnapStyl" Temp1)
)
;***** Define Routine To Extract Data From Entities
; Then Draw Entity
;***** In Isometric View! -- SOLID
(DEFUN SOLID_Extract_Draw ( / P10 P11 P12 P13)
(SETQ NS (+ NS 1)) ; One More Solid Is Processed!
(SETQ FLAG 1)
(SETQ P10 (CDR (ASSOC '10 EntData))) ; Get 1st Point
(Calc_Point P10)(SETQ P10 New_Point)
(SETQ P11 (CDR (ASSOC '11 EntData))) ; Get 2nd Point
(Calc_Point P11)(SETQ P11 New_Point)
(SETQ P12 (CDR (ASSOC '12 EntData))) ; Get 3rd Point
(Calc_Point P12)(SETQ P12 New_Point)
(SETQ P13 (CDR (ASSOC '13 EntData))) ; Get 4th Point
(Calc_Point P13)(SETQ P13 New_Point)
(COMMAND "SOLID" P10 P11 P12 P13 "")
(SETQ NewSet (SSADD (ENTLAST) NewSet))
)
;***** Define Routine To Extract Data From Entities
; Then Draw Entity
;***** In Isometric View! -- TEXT
(DEFUN TEXT_Extract_Draw ( / TxtStrg Insert TxtHgt TxtStyl Align
TD ITxtStyl IOblAngl IAlign)
(SETQ NT (+ NT 1)) ; One More Text Is Processed!
(SETQ FLAG 1)
; If ISO Style Isn't Current, Change To Style ISO
(IF (/= (GETVAR "TextStyle") "ISO")
(PROGN
(COMMAND "STYLE" "ISO" ; Change To Iso Style Text
"TXT" ; Font File
"0" ; Height
"1.00" ; Width
"0" ; Obliquing Angle
"N" ; BackWards?
"N" ; Upside Down?
"N" ; Vertical?
)
(PROMPT "\nWorking.....\n\n")
)
)
(SETQ TxtStrg (CDR (ASSOC '1 EntData)) ; Get String Data
Insert (CDR (ASSOC '10 EntData)) ; Get Insertion Point
TxtHgt (CDR (ASSOC '40 EntData)) ; Get Text Height
TxtStyl (ASSOC '7 EntData) ; Get String Style
Align (ASSOC '72 EntData) ; Get Alignment Data
)
(Calc_Point Insert)(SETQ Insert New_Point)
; ReCalc Insertion PNT
(IF (= Iso_View "L")
(PROGN (SETQ TxtAng "330")(SETQ OblAng
(CONS '51 (DTR 330))))
)
(IF (= Iso_View "TR")
(PROGN (SETQ TxtAng "30")(SETQ OblAng (CONS '51
(DTR 330))))
)
(IF (= Iso_View "R")
(PROGN (SETQ TxtAng "30")(SETQ OblAng (CONS '51
(DTR 30))))
)
(COMMAND "TEXT" Insert TxtHgt TxtAng TxtStrg)
; Draw Initial Text
(SETQ NewSet (SSADD (ENTLAST) NewSet)) ; Add It To NewSet
(SETQ TD (ENTGET (ENTLAST)) ; Get Text Data
ITxtStyl (ASSOC '7 TD) ; Get String Style
IOblAng (ASSOC '51 TD) ; Get Obliquing Angle
IAlign (ASSOC '72 EntData) ; Get Alignment Data
)
(SETQ TD (SUBST TxtStyl ITxtStyl TD) ; Swap Text Style
TD (SUBST Align IAlign TD) ; Swap Alignment
TD (SUBST OblAng IOblAng TD) ; Swap Obliquing
)
(ENTMOD TD) ; Modify It!
)
;***** Change Degrees to Radians!
(DEFUN DTR (a)
(* pi (/ a 180.0))
)
;***** Change Radians to Degrees!
(DEFUN RTD (a)
(* 180.0 (/ a pi))
)
;***** Display Results To User
(DEFUN Display_Results (/)
(REPEAT 2 (TERPRI))
(PROMPT "\nIsometric Results: ")
(PROMPT " Arcs=")(Princ NA)
(PROMPT " Lines=")(Princ NL)
(PROMPT " Circles=")(Princ NC)
(PROMPT " Solid=")(Princ NS)
(PROMPT " Text=")(Princ NT)
(PROMPT " Other=")(Princ O)
(PROMPT "\n ")(PRINC)
)
;**** Define Routine To Restore Initial Variable Settings
(DEFUN SHUTDOWN ()
; If We've Changed Styles, Change It Back!
(IF (= (GETVAR "TextStyle") "ISO")
(COMMAND "STYLE" STXT "" "" "" "" "" "" "")
)
(SETVAR "BlipMode" Blip) ; Revert To Original Setting
(SETVAR "OSMode" Snap) ; Revert To Original Setting
(SETVAR "CmdEcho" 1) ; Turn COMMAND Echo On
(PRINC) ; Soft Exit
)
;*** Function Takes Point And Converts It To An Isometric Point!
(DEFUN Calc_Point ( POINT / PX PY PZ DFBX DFBY DFXY)
(SETQ PX (nth 0 POINT) ; Get X Co-ord.
PY (nth 1 POINT) ; Get Y Co-ord.
PZ 0.0 ; Get Z Co-ord.
DFBX (- PX BPX) ; Calculate Distance From Base X
DFBY (- PY BPY) ; Calculate Distance From Base Y
DFXY (- DFBX DFBY); Calculate Difference From DFBX-DFBY
)
(COND
((= Iso_View "R") ; Right View Isometric
(PROGN
(SETQ PY (+ PY (* DFBX (SIN (DTR 30)))))
(SETQ PX (- PX (- DFBX (* DFBX (COS (DTR 30))))))
)
)
((= Iso_View "L") ; Left View Isometric
(PROGN
(SETQ PY (- PY (* DFBX (SIN (DTR 30)))))
(SETQ PX (- PX (- DFBX (* DFBX (COS (DTR 30))))))
)
)
((= Iso_View "TR") ; Top Right View Isometric
(PROGN
(SETQ PY (+ PY (* DFXY (SIN (DTR 30)))))
(SETQ PX (- (+ BPX (* DFBX (COS (DTR 30))))
(* DFBY (COS (DTR 30)))
)
)
)
)
)
(SETQ New_Point (LIST PX PY PZ))
)
;************************* MAIN LINE **************************
(DEFUN C:ISO ( / Blip SelSet NewSet New_Point Depth STxt
NL NC NA NS NT O BPX BPY Snap DepthAngle
)
(SetUp) ; SetUp Environment
(Setup_Layer) ; Ask Layer Information
(Get_Entities) ; Select An Entity Selection Set
(Which_View) ; Get Which View To Draw Iso
(Change_To_Iso) ; Change Entities To ISOMETRIC
(ShutDown) ; Set Vars. etc., to original values
(Display_Results) ; Tell User Results
)
(DEFUN C:DELISO ()
(SETQ SetUp nil
SetUp_Layer nil
Get_Entities nil
Which_View nil
Change_To_Iso nil
Arc_Extract_Draw nil
Line_Extract_Draw nil
Circle_Extract_Draw nil
Solid_Extract_Draw nil
Text_Extract_Draw nil
DTR nil
RTD nil
Display_Results nil
ShutDown nil
Calc_Point nil
C:ISO nil
)
)
(PRINC)
;END
