home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1993 #2 / Image.iso / cad / jul93.zip / ISO.LSP < prev    next >
Text File  |  1993-06-21  |  18KB  |  600 lines
  1. ; ISO.LSP
  2. ; copyright 1993, Trevor Churchill
  3.  
  4. (REPEAT 3 (PROMPT "\n          ")) ; 10 Spaces
  5. (PROMPT " Isometric Routine By Trevor Churchill (c) 1992 \n")
  6. ;*****************************************************
  7. ;    FILENAME : ISO.LSP
  8. ;     VERSION : 1.00
  9. ;        NAME : Trevor Churchill
  10. ;     ADDRESS : Box 991, Kindersley, Saskatchewan S0L 1S0
  11. ;        DATE : November, 1992
  12. ; DESCRIPTION : Converts Arcs,Circles,Lines,Solids & Text To
  13. ;               Isometric Views. Polylines,Blocks & Dims. 
  14. ;               Must Be Exploded First
  15. ; SAMPLE CALL : ISO
  16.  
  17.  
  18. ;***** Define New Error Handling Routine
  19.  
  20. (DEFUN *error* (msg / )
  21.    (PRINC "error: ")
  22.    (PRINC MSG) ;Print Error Message To Screen
  23.    (TERPRI)    ;LineFeed
  24.    (SHUTDOWN)  ;Make Sure Everything Is Set To Original Values
  25. )
  26.  
  27.  
  28. ;**** Define Routine To Setup Initial Variable Settings
  29.  
  30. (DEFUN SETUP ()
  31.  
  32.    (SETQ NL 0                     ; Number Of Lines Redrawn
  33.          NC 0                     ; Number Of Circles Redrawn
  34.          NA 0                     ; Number Of Arcs Redrawn
  35.          NS 0                     ; Number Of Solid Redrawn
  36.          NT 0                     ; Number Of Text Redrawn
  37.          O 0                      ; Number Of Other Entities
  38.          NewSet (SSadd)           ; Make Empty Selection Set
  39.          Blip (GETVAR "BlipMode") ; Save Initial Setting In Blip
  40.          STxt (GETVAR "TextStyle"); Save Initial Setting In STxt
  41.          Snap (GETVAR "OSMode")   ; Save Initial Setting In STxt
  42.  
  43.    )
  44.  
  45.    (SETVAR "CmdEcho" 0)           ; Turn COMMAND Echo Off
  46.    (SETVAR "BlipMode" 0)          ; Turn BLIPMODE Off
  47.    (SETVAR "OSMode" 0)            ; Turn OSNAPS To NONE
  48.  
  49.    ;***** If MoveToLayer Hasn't Been Set, 
  50.    ;      Set Default to Original
  51.    (IF (NOT MoveToLayer)(SETQ MoveToLayer "Original"))
  52.  
  53.    ;***** If Iso_View Hasn't Been Set, Set It To Right View
  54.    (IF (NOT Iso_View)(SETQ Iso_View "R"))
  55.  
  56.    ;***** If Thickness Hasn't Been Set, Set Default To 0
  57.    (IF (NOT Thickness)(SETQ Thickness 0.0))
  58.  
  59. )
  60.  
  61. ;***** Setup Layer Information
  62.  
  63. (DEFUN Setup_Layer ( / Ans)
  64.  
  65.    ;***** Get Information On Which Layer To Put
  66.    ;      Original Entities
  67.    (SETQ Ans (GETSTRING
  68.                (STRCAT
  69.                   "\nWhich Layer To Put Original Entities On?<"
  70.                   MoveToLayer
  71.                   ">"
  72.                )
  73.              )
  74.     )
  75.     (IF (= Ans "")(SETQ Ans MoveToLayer))
  76.     (SETQ MoveToLayer Ans)
  77.  
  78.     (IF (NOT (TBLSEARCH "LAYER" MoveToLayer))
  79.                       ; Does The Layer Exist?
  80.       (COMMAND "LAYER" "N" MoveToLayer "")  
  81.                       ; Doesn't Exist, Create!
  82.     )
  83.  
  84.    ;***** Get Information On Whether To Give 
  85.    ;      View A Thickness Or Not
  86.    (SETQ Ans (GETREAL (STRCAT
  87.                        "\nEnter Thickness Of View <"
  88.                        (RTOS Thickness)
  89.                        ">"
  90.                       )
  91.              )
  92.    )
  93.  
  94.    (IF (= Ans NIL)(SETQ Ans Thickness))
  95.    (SETQ Thickness Ans)
  96.  
  97. )
  98.  
  99. ;***** Get Entitiy Selection Set From User
  100.  
  101. (DEFUN GET_ENTITIES ( / Base_Point)
  102.  
  103.    (PROMPT 
  104.        "\nArcs,Circles,Lines,Solids & Text Will Be Processed!!")
  105.    (PROMPT 
  106.        "\nPlease Select Entities To Change To Isometric....")
  107.    (SETQ SELSET (SSGET));Get Selection Set From User
  108.  
  109.    (SETQ
  110.       Base_Point (GETPOINT 
  111. "\nPick A BasePoint For The Iso Figure:(Lower Left-Hand Corner)")
  112.       BPX (CAR Base_Point)  ; Extract X Value From Base Point
  113.       BPY (CADR Base_Point) ; Extract Y Value From Base Point
  114.    )
  115.  
  116. )
  117.  
  118. ;***** Ask User Which Isometric View Should Be Used
  119.  
  120.  
  121. (DEFUN Which_View ( / Ans)
  122.  
  123.     (TERPRI)                ; Print Blank Line
  124.     (INITGET "L R TR")      ; Choices = Left,Right,Top R and Nil
  125.     (SETQ Ans (GETKWORD     ; Get Answer From User
  126.                 (STRCAT
  127.                  "Which Isometric View? : "
  128.                  "L-Left;R-Right;TR-Top Right <"
  129.                   Iso_View
  130.                  ">"
  131.                 )
  132.               )
  133.     )
  134.  
  135.     (IF (= Ans NIL)(SETQ Ans Iso_View))
  136.     (SETQ Iso_View Ans)
  137.  
  138.     ;***** Set Up Depths For Creating Thicknesses
  139.     (SETQ DepthAngle 270)
  140.     (If (= Iso_View "R")(SETQ DepthAngle 150))
  141.     (If (= Iso_View "L")(SETQ DepthAngle 30))
  142.     (SETQ Depth (STRCAT "@" (RTOS Thickness) "<" (RTOS DepthAngle)))
  143.  
  144. )
  145.  
  146. ;***** Pick Out Entities From Selection Set And Change To Iso
  147.  
  148. (DEFUN Change_To_Iso ( / EntName EntData EntType SL Index Flag)
  149.  
  150.    (PROMPT "\nWorking.....\n\n")
  151.  
  152.    ; Copy Original To Specified Layer If Different 
  153.    ; From Current Layer
  154.    (IF (/= MoveToLayer (GETVAR "CLAYER"))
  155.         (COMMAND "CHANGE" SelSet "" "P" "Layer" MoveToLayer "")
  156.    )
  157.  
  158.    (SETQ SL (SSLENGTH SelSet))               ; Get Length Of Sel. Set
  159.    (SETQ Index 0)                            ; Set Index to 0
  160.  
  161.    (WHILE (< Index SL)                       ; Loop Until End Of SelSet
  162.  
  163.       (SETQ FLAG 0)
  164.       (SETQ EntName (SSNAME SelSet Index))   ; Get Indexed Entity Name
  165.       (SETQ EntData (ENTGET EntName))        ; Get Entity Data
  166.       (SETQ EntType (CDR (ASSOC 0 EntData))) ; Extract Type
  167.  
  168.       ;***** Check For Entity Types And Call Proper Routine
  169.  
  170.       (IF (= EntType "LINE")(Line_Extract_Draw))
  171.  
  172.       (IF (= EntType "CIRCLE")(Circle_Extract_Draw))
  173.  
  174.       (IF (= EntType "ARC")(Arc_Extract_Draw))
  175.  
  176.       (IF (= EntType "TEXT")(Text_Extract_Draw))
  177.  
  178.       (IF (= EntType "SOLID")(Solid_Extract_Draw))
  179.  
  180.       (IF (= FLAG 0)
  181.          (PROGN
  182.             (PROMPT 
  183.            "\nBlocks, Dimensions & PolyLines Must Be Exploded!")
  184.             (PROMPT "\nWorking.....")
  185.             (SETQ O (+ O 1)) ; Increment Other Count
  186.          )
  187.       )
  188.       (SETQ Index (+ Index 1))               ; Increment Index
  189.  
  190.    )
  191.  
  192.    ;*************************
  193.    ; IF There is A Thickness Copy Entities To Show Thickness
  194.    (IF (> Thickness 0)
  195.       (COMMAND "COPY" NewSet "" "0,0" Depth)
  196.    )
  197.  
  198. )
  199.  
  200. ;Define Routine To Extract Data From Entities Then Draw Entity
  201. ;***** In Isometric View! -- ARC
  202.  
  203. (DEFUN ARC_Extract_Draw ( / Center Radius StartAng EndAng 
  204. First Second PickOne PickTwo Temp Temp1 TrimLines )
  205.  
  206.    (SETQ NA (+ NA 1)          ; One More Is Processed!
  207.          FLAG 1
  208.    )
  209.  
  210.    (SETQ Center (CDR (ASSOC '10 EntData))  ; Center Of Arc
  211.          Radius (CDR (ASSOC '40 EntData))  ; Radius of Arc
  212.          StartAng (CDR (ASSOC '50 EntData)); Starting Angle
  213.          EndAng (CDR (ASSOC '51 EntData))  ; Ending Angle
  214.    )
  215.  
  216.    ;***** Calculate Trim Line End Points!
  217.    (SETQ First (POLAR Center StartAng (* 1.2 Radius)))
  218.    (Calc_Point First)(SETQ First New_Point)
  219.    (SETQ Second (POLAR Center EndAng (* 1.2 Radius)))
  220.    (Calc_Point Second)(SETQ Second New_POINT)
  221.  
  222.    ;***** Calculate Trim Pick Points!
  223.    (SETQ PickOne (POLAR Center (- StartAng (DTR 10)) Radius))
  224.    (Calc_Point PickOne)(SETQ PickOne New_Point)
  225.    (SETQ PickTwo (POLAR Center (+ EndAng (DTR 10)) Radius))
  226.    (Calc_Point PickTwo)(SETQ PickTwo New_Point)
  227.  
  228.    ;***** Calculate Isometric Center Point
  229.    (Calc_Point Center)(Setq Center New_Point)
  230.  
  231.    (SETQ Temp (GETVAR "SnapIsoPair"))   ; Get Initial Iso Vars.
  232.    (SETQ Temp1 (GETVAR "SnapStyl"))
  233.  
  234.    (SETVAR "SnapStyl" 1)                ; Set To Isometric
  235.  
  236.    ;***** Set To Proper View
  237.    (IF (= Iso_View "L")(SETVAR "SnapIsoPair" 0))
  238.    (IF (= Iso_View "TR")(SETVAR "SnapIsoPair" 1))
  239.    (IF (= Iso_View "R")(SETVAR "SnapIsoPair" 2))
  240.  
  241.    (COMMAND "ELLIPSE" "I" Center Radius) ; Draw Iso-Circle
  242.  
  243.    (SETVAR "SnapIsoPair" Temp)           ; Revert To Original
  244.    (SETVAR "SnapStyl" Temp1)             ; Isometric Values
  245.  
  246.    (COMMAND "PLINE" First Center Second "") ; Draw Trim Lines
  247.    (SETQ TrimLines (ENTLAST))
  248.  
  249.    (COMMAND "TRIM" TrimLines "" PickOne PickTwo "") Trim Circle
  250.    (SETQ NewSet (SSADD (ENTLAST) NewSet)) ; Add It To NewSet
  251.  
  252.    (COMMAND "ERASE" TrimLines "")        ; Erase Trim Lines
  253.    (PROMPT "\nWorking.....\n\n")
  254.  
  255. )
  256.  
  257. ;**** Define Routine To Extract Data From Entities 
  258. ;     Then Draw Entity
  259. ;**** In Isometric View! -- LINE
  260.  
  261. (DEFUN Line_Extract_Draw ( / Start End)
  262.  
  263.    (SETQ NL (+ NL 1))           ; One More Line Is Processed!
  264.    (SETQ FLAG 1)
  265.  
  266.    (SETQ Start (CDR (ASSOC 10 EntDATA))  ; Extract Start Point
  267.          End (CDR (ASSOC 11 EntDATA))    ; Extract End Point
  268.    )
  269.  
  270. ;********** Recalculate Start Point
  271.    (Calc_Point Start)
  272.    (SETQ Start New_Point)
  273.  
  274. ;********** Recalculate End Point
  275.    (Calc_Point End)
  276.    (SETQ End New_Point)
  277.  
  278. ;********** Draw New Line In Isometric
  279.    (COMMAND "LINE" Start End "")
  280.    (SETQ NewSet (SSADD (ENTLAST) NewSet)) ; Add It To NewSet
  281.  
  282. ;********** Add Depth Thickness Line If Thickness Is Set
  283.    (IF (> Thickness 0)
  284.       (PROGN
  285.          (COMMAND "LINE" Start Depth "")
  286.          (COMMAND "LINE" End Depth "")
  287.       )
  288.    )
  289. )
  290.  
  291. ;***** Define Routine To Extract Data From Entities 
  292. ;      Then Draw Entity
  293. ;***** In Isometric View! -- CIRCLE
  294.  
  295.  
  296. (DEFUN Circle_Extract_Draw ( / Temp Temp1 Center Radius Ang Cen
  297.                            L1 L2 Depth1 Depth2 PP1 PP2)
  298.  
  299.    (SETQ NC (+ NC 1))             ; One More Processed!
  300.    (SETQ FLAG 1)
  301.  
  302.    (SETQ Center (CDR (ASSOC '10 EntData)) ; Get Center Point
  303.          Cen Center                       ; Store It Also In Cen
  304.          Radius (CDR (ASSOC '40 EntData)) ; Get Circle Radius
  305.    )
  306.  
  307.    (Calc_Point Center)(SETQ Center New_Point) 
  308.                                           ; Calculate New Center
  309.  
  310.    (SETQ Temp (GETVAR "SnapIsoPair"))
  311.    (SETQ Temp1 (GETVAR "SnapStyl"))
  312.  
  313.    (SETVAR "SnapStyl" 1) ; Set To Isometric Grid
  314.  
  315.    (IF (= Iso_View "L")  ; Set To Proper View, Top,Left Or Right
  316.       (SETVAR "SnapIsoPair" 0)
  317.    )
  318.    (IF (= Iso_View "TR")
  319.       (SETVAR "SnapIsoPair" 1)
  320.    )
  321.    (IF (= Iso_View "R")
  322.       (SETVAR "SnapIsoPair" 2)
  323.    )
  324.  
  325.    (COMMAND "ELLIPSE" "I" Center Radius)
  326.    (SETQ Circle (ENTLAST))
  327.  
  328.    ;***** If Thickness Set, Draw Depth Lines
  329.    (IF (/= Thickness 0)
  330.      (PROGN
  331.  
  332.       (IF (= Iso_View "R")(SETQ LineAng1 45
  333.                                 LineAng2 225
  334.                                 TrimAng1 40
  335.                                 TrimAng2 230
  336.                           )
  337.       )
  338.       (IF (= Iso_View "L")(SETQ LineAng1 135
  339.                                 LineAng2 315
  340.                                 TrimAng1 140
  341.                                 TrimAng2 310
  342.                           )
  343.       )
  344.  
  345.       (IF (= Iso_View "TR")(SETQ LineAng1 135
  346.                                  LineAng2 315
  347.                                  TrimAng1 130
  348.                                  TrimAng2 320
  349.                            )
  350.       )
  351.  
  352.       (SETQ Depth1 (POLAR Cen (DTR LineAng1) Radius))
  353.       (Calc_Point Depth1)(SETQ Depth1 New_Point)
  354.  
  355.       (SETQ Depth2 (POLAR Cen (DTR LineAng2) Radius))
  356.       (Calc_Point Depth2)(SETQ Depth2 New_Point)
  357.  
  358.       (COMMAND "LINE" Depth1 Depth "")(SETQ L1 (ENTLAST))
  359.       (COMMAND "LINE" Depth2 Depth "")(SETQ L2 (ENTLAST))
  360.  
  361.       (COMMAND "COPY" Circle "" "0,0" Depth)
  362.  
  363.       (SETQ PP1 (POLAR Cen (DTR TrimAng1) Radius))
  364.       (Calc_Point PP1)(SETQ PP1 New_Point)
  365.       (SETQ PP2 (POLAR Cen (DTR TrimAng2) Radius))
  366.       (Calc_Point PP2)(SETQ PP2 New_Point)
  367.  
  368.       (SETQ PP1 (POLAR PP1 (DTR DepthAngle) Thickness))
  369.       (SETQ PP2 (POLAR PP2 (DTR DepthAngle) Thickness))
  370.       (COMMAND "TRIM" L1 L2 "" PP1 PP2 "")
  371.      )
  372.    )
  373.  
  374.    (SETVAR "SnapIsoPair" Temp)
  375.    (SETVAR "SnapStyl" Temp1)
  376.  
  377. )
  378.  
  379. ;***** Define Routine To Extract Data From Entities 
  380. ;      Then Draw Entity
  381. ;***** In Isometric View! -- SOLID
  382.  
  383. (DEFUN SOLID_Extract_Draw ( / P10 P11 P12 P13)
  384.  
  385.    (SETQ NS (+ NS 1))        ; One More Solid Is Processed!
  386.    (SETQ FLAG 1)
  387.  
  388.    (SETQ P10 (CDR (ASSOC '10 EntData))) ; Get 1st Point
  389.    (Calc_Point P10)(SETQ P10 New_Point)
  390.  
  391.    (SETQ P11 (CDR (ASSOC '11 EntData))) ; Get 2nd Point
  392.    (Calc_Point P11)(SETQ P11 New_Point)
  393.  
  394.    (SETQ P12 (CDR (ASSOC '12 EntData))) ; Get 3rd Point
  395.    (Calc_Point P12)(SETQ P12 New_Point)
  396.  
  397.    (SETQ P13 (CDR (ASSOC '13 EntData))) ; Get 4th Point
  398.    (Calc_Point P13)(SETQ P13 New_Point)
  399.  
  400.    (COMMAND "SOLID" P10 P11 P12 P13 "")
  401.    (SETQ NewSet (SSADD (ENTLAST) NewSet))
  402.  
  403. )
  404.  
  405. ;***** Define Routine To Extract Data From Entities
  406. ;      Then Draw Entity
  407. ;***** In Isometric View! -- TEXT
  408.  
  409. (DEFUN TEXT_Extract_Draw ( / TxtStrg Insert TxtHgt TxtStyl Align
  410.                              TD ITxtStyl IOblAngl IAlign)
  411.  
  412.    (SETQ NT (+ NT 1))    ; One More Text Is Processed!
  413.    (SETQ FLAG 1)
  414.  
  415.    ; If ISO Style Isn't Current, Change To Style ISO
  416.    (IF (/= (GETVAR "TextStyle") "ISO")
  417.       (PROGN
  418.         (COMMAND "STYLE" "ISO"    ; Change To Iso Style Text
  419.                          "TXT"             ; Font File
  420.                          "0"               ; Height
  421.                          "1.00"            ; Width
  422.                          "0"               ; Obliquing Angle
  423.                          "N"               ; BackWards?
  424.                          "N"               ; Upside Down?
  425.                          "N"               ; Vertical?
  426.          )
  427.          (PROMPT "\nWorking.....\n\n")
  428.       )
  429.  
  430.    )
  431.  
  432.    (SETQ TxtStrg (CDR (ASSOC '1 EntData))  ; Get String Data
  433.          Insert (CDR (ASSOC '10 EntData))  ; Get Insertion Point
  434.          TxtHgt (CDR (ASSOC '40 EntData))  ; Get Text Height
  435.          TxtStyl (ASSOC '7 EntData)        ; Get String Style
  436.          Align (ASSOC '72 EntData)         ; Get Alignment Data
  437.    )
  438.  
  439.    (Calc_Point Insert)(SETQ Insert New_Point) 
  440.                                           ; ReCalc Insertion PNT
  441.  
  442.    (IF (= Iso_View "L")
  443.       (PROGN (SETQ TxtAng "330")(SETQ OblAng 
  444.                           (CONS '51 (DTR 330))))
  445.    )
  446.    (IF (= Iso_View "TR")
  447.       (PROGN (SETQ TxtAng "30")(SETQ OblAng (CONS '51   
  448.                           (DTR 330))))
  449.    )
  450.    (IF (= Iso_View "R")
  451.       (PROGN (SETQ TxtAng "30")(SETQ OblAng (CONS '51 
  452.                           (DTR 30))))
  453.    )
  454.  
  455.    (COMMAND "TEXT" Insert TxtHgt TxtAng TxtStrg)
  456.                                            ; Draw Initial Text
  457.    (SETQ NewSet (SSADD (ENTLAST) NewSet))  ; Add It To NewSet
  458.  
  459.    (SETQ TD (ENTGET (ENTLAST))              ; Get Text Data
  460.          ITxtStyl (ASSOC '7 TD)             ; Get String Style
  461.          IOblAng (ASSOC '51 TD)             ; Get Obliquing Angle
  462.          IAlign (ASSOC '72 EntData)         ; Get Alignment Data
  463.    )
  464.  
  465.    (SETQ TD (SUBST TxtStyl ITxtStyl TD)      ; Swap Text Style
  466.          TD (SUBST Align IAlign TD)          ; Swap Alignment
  467.          TD (SUBST OblAng IOblAng TD)        ; Swap Obliquing
  468.    )
  469.    (ENTMOD TD)                               ; Modify It!
  470.  
  471. )
  472.  
  473. ;***** Change Degrees to Radians!
  474.  
  475. (DEFUN DTR (a)
  476.    (* pi (/ a 180.0))
  477. )
  478.  
  479. ;***** Change Radians to Degrees!
  480.  
  481. (DEFUN RTD (a)
  482.    (* 180.0 (/ a pi))
  483. )
  484.  
  485. ;***** Display Results To User
  486.  
  487. (DEFUN Display_Results (/)
  488.  
  489.    (REPEAT 2 (TERPRI))
  490.    (PROMPT "\nIsometric Results: ")
  491.    (PROMPT " Arcs=")(Princ NA)
  492.    (PROMPT " Lines=")(Princ NL)
  493.    (PROMPT " Circles=")(Princ NC)
  494.    (PROMPT " Solid=")(Princ NS)
  495.    (PROMPT " Text=")(Princ NT)
  496.    (PROMPT " Other=")(Princ O)
  497.    (PROMPT "\n ")(PRINC)
  498.  
  499. )
  500.  
  501. ;**** Define Routine To Restore Initial Variable Settings
  502.  
  503. (DEFUN SHUTDOWN ()
  504.  
  505.    ; If We've Changed Styles, Change It Back!
  506.    (IF (= (GETVAR "TextStyle") "ISO")
  507.         (COMMAND "STYLE" STXT "" "" "" "" "" "" "")
  508.    )
  509.    (SETVAR "BlipMode" Blip)       ; Revert To Original Setting
  510.    (SETVAR "OSMode" Snap)         ; Revert To Original Setting
  511.    (SETVAR "CmdEcho" 1)           ; Turn COMMAND Echo On
  512.    (PRINC)                        ; Soft Exit
  513.  
  514. )
  515.  
  516. ;*** Function Takes Point And Converts It To An Isometric Point!
  517.  
  518. (DEFUN Calc_Point   ( POINT / PX PY PZ DFBX DFBY DFXY)
  519.  
  520.    (SETQ PX (nth 0 POINT)  ; Get X Co-ord.
  521.          PY (nth 1 POINT)  ; Get Y Co-ord.
  522.          PZ 0.0            ; Get Z Co-ord.
  523.          DFBX (- PX BPX)   ; Calculate Distance From Base X
  524.          DFBY (- PY BPY)   ; Calculate Distance From Base Y
  525.          DFXY (- DFBX DFBY); Calculate Difference From DFBX-DFBY
  526.    )
  527.  
  528.    (COND
  529.  
  530.       ((= Iso_View "R")     ; Right View Isometric
  531.          (PROGN
  532.             (SETQ PY (+ PY (* DFBX (SIN (DTR 30)))))
  533.             (SETQ PX (- PX (- DFBX (* DFBX (COS (DTR 30))))))
  534.          )
  535.       )
  536.  
  537.       ((= Iso_View "L")          ; Left View Isometric
  538.          (PROGN
  539.             (SETQ PY (- PY (* DFBX (SIN (DTR 30)))))
  540.             (SETQ PX (- PX (- DFBX (* DFBX (COS (DTR 30))))))
  541.          )
  542.       )
  543.  
  544.       ((= Iso_View "TR")         ; Top Right View Isometric
  545.         (PROGN
  546.             (SETQ PY (+ PY (* DFXY (SIN (DTR 30)))))
  547.             (SETQ PX (- (+ BPX (* DFBX (COS (DTR 30))))
  548.                         (* DFBY (COS (DTR 30)))
  549.                      )
  550.             )
  551.         )
  552.       )
  553.  
  554.  
  555.    )
  556.  
  557.    (SETQ New_Point (LIST PX PY PZ))
  558.  
  559. )
  560.  
  561.  
  562. ;************************* MAIN LINE **************************
  563.  
  564. (DEFUN C:ISO   ( / Blip SelSet NewSet New_Point Depth STxt
  565.                    NL NC NA NS NT O BPX BPY Snap DepthAngle
  566.                )
  567.  
  568.    (SetUp)                   ; SetUp Environment
  569.    (Setup_Layer)             ; Ask Layer Information
  570.    (Get_Entities)            ; Select An Entity Selection Set
  571.    (Which_View)              ; Get Which View To Draw Iso
  572.    (Change_To_Iso)           ; Change Entities To ISOMETRIC
  573.    (ShutDown)                ; Set Vars. etc., to original values
  574.    (Display_Results)         ; Tell User Results
  575. )
  576.  
  577. (DEFUN C:DELISO ()
  578.         (SETQ SetUp nil
  579.               SetUp_Layer nil
  580.               Get_Entities nil
  581.               Which_View nil
  582.               Change_To_Iso nil
  583.               Arc_Extract_Draw nil
  584.               Line_Extract_Draw nil
  585.               Circle_Extract_Draw nil
  586.               Solid_Extract_Draw nil
  587.               Text_Extract_Draw nil
  588.               DTR nil
  589.               RTD nil
  590.               Display_Results nil
  591.               ShutDown nil
  592.               Calc_Point nil
  593.               C:ISO nil
  594.         )
  595. )
  596.  
  597. (PRINC)
  598.  
  599. ;END 
  600.