DCL Radio Buttons

July 28, 2009

Buzzard,
I have a situation where I need the size but not the type for some pipes. I have tried to comment out the type but when I run it it seems to get stuck in a loop and I have to force Cad to shut down. Any thoughts on this would help.

Also I have been thinking about the Line Width and would like to run both without that. I want to reduce the options the guys have to make things different.

Thanks.

Try this:

LSP

;//////////////////////////////////////////////////////////////////////////
;
; Start-Up Function
;
(defun C:ESS ()
 (POPUP_MF)
 (princ)
)
;
;//////////////////////////////////////////////////////////////////////////
;
; Main Function
;
(defun POPUP_MF (/ SIZE$ SIZE SUCE  SUOM  SUSM SUAB SUAD MIDPT PLEN
                  PT01  PT02 a b)
 (setq SUCE (getvar "cmdecho"))
 (setq SUOM (getvar "orthomode"))
 (setq SUSM (getvar "osmode"))
 (setq SUAB (getvar "angbase"))
 (setq SUAD (getvar "angdir"))
 (setq temperr *error*)
 (setq *error* ETRAP)
 (setq S1_list
  '("1500mm" "1350mm"
    "1200mm" "1050mm"
     "900mm"  "750mm"
     "675mm"  "600mm"
     "525mm"  "450mm"
     "375mm"  "300mm"
     "225mm"  "150mm"
   )
 )
 (setq dcl_id (load_dialog "ESS.dcl"))
 (if
   (not
     (new_dialog "ESS" dcl_id)
   )
   (progn
     (ALERT "Can not find your dcl file")
     (exit)
   )
 )
 (start_list "S1")
 (mapcar 'add_list S1_list)
 (end_list)
 (if SIZE:DEF
   (set_tile "S1" (itoa SIZE:DEF))
 )
 (action_tile "cancel"
  "(done_dialog)(setq userclick nil)"
 )
 (action_tile "accept"
   (strcat
    "(progn
     (setq S:IZE (atoi (get_tile \"S1\")) SIZE:DEF S:IZE)"
    "(done_dialog)(setq userclick T))"
   )
 )
 (start_dialog)
 (unload_dialog dcl_id)
 (if userclick
   (VARIABLE)
 )
 (princ)
)
;
;//////////////////////////////////////////////////////////////////////////
;
; Variable Function
;
(defun VARIABLE ()
 (progn 
   (setq SIZE$ (fix S:IZE))
   (setq SIZE$ (nth S:IZE S1_list))
   (cond
     ((= SIZE$ "1500mm")(setq SIZE$ "1500"))
     ((= SIZE$ "1350mm")(setq SIZE$ "1350"))
     ((= SIZE$ "1200mm")(setq SIZE$ "1200"))
     ((= SIZE$ "1050mm")(setq SIZE$ "1050"))
     ((= SIZE$  "900mm")(setq SIZE$  "900"))
     ((= SIZE$  "750mm")(setq SIZE$  "750"))
     ((= SIZE$  "675mm")(setq SIZE$  "675"))
     ((= SIZE$  "600mm")(setq SIZE$  "600"))
     ((= SIZE$  "525mm")(setq SIZE$  "525"))
     ((= SIZE$  "450mm")(setq SIZE$  "450"))
     ((= SIZE$  "375mm")(setq SIZE$  "375"))
     ((= SIZE$  "300mm")(setq SIZE$  "300"))
     ((= SIZE$  "225mm")(setq SIZE$  "225"))
     ((= SIZE$  "150mm")(setq SIZE$  "150"))
   )
 )
 (setq SIZE SIZE$) 
 (OUTPUT)
 (princ)
)
;
;//////////////////////////////////////////////////////////////////////////
;
; Output Function
;
(defun OUTPUT ()
 (setq a (strcat "CCC_DR_"SIZE)
       b (strcat "CCC_SERVICES_EXISTING_Drainage_Storm_Sewer_"SIZE)
 )
 (if
   (not
     (tblsearch "LTYPE" a)
   )
   (command "_.-linetype" "_l" a "CCC_Drainage.lin" "")
 )
 (command "_.-layer" "_N" b "_M" b "_L" a b "_C" "84" b "_LW" "0.3" b "" )
 (setvar "angbase" 0.0000)
 (setvar "angdir"  0)
 (setvar "orthomode" 0)
 (setvar "osmode"    16383)
 (setq PT01 (getpoint "\nEnter the line start point:"))
 (while
   (/= nil
     (setq PT02 (getpoint pt01 "\nEnter the line end point:"))
   )
   (setvar "osmode" 0)
   (command "_.pline" PT01 PT02 "")
   (setq RADIANS (angle PT01 PT02))
   (setq DEGREES (RTD RADIANS))
   (setq PLEN (distance PT01 PT02))
   (setq MIDPT (polar PT01 (DTR DEGREES)(/ PLEN 2.0)))
   (setq PT01 PT02)
   (setvar "osmode" 16383)
   (if
     (and
       (>  DEGREES 90.0)
       (<= DEGREES 270.0)
     )
     (command "_.rotate" "last" "" MIDPT "180.0")
   )
 )
 (setq *error* temperr)
 (setvar "cmdecho"   SUCE)
 (setvar "orthomode" SUOM)
 (setvar "osmode"    SUSM)
 (setvar "angbase"   SUAB)
 (setvar "angdir"    SUAD)
 (princ)
)
;
;//////////////////////////////////////////////////////////////////////////
;
; Degrees to Radians Function
;
(defun DTR (DEGREES)
(* pi (/ DEGREES 180.0))
)
;
;//////////////////////////////////////////////////////////////////////////
;
; Radians to Degrees Function
;
(defun RTD (RADIANS)
 (* 180.0 (/ RADIANS pi))
)
;
;//////////////////////////////////////////////////////////////////////////
;
; Error Trap Function
;
(defun ETRAP (errmsg)
 (command nil nil nil)
 (if
   (not
     (member errmsg '("console break" "Function Cancelled"))
   )
   (princ (strcat "\nError:" errmsg))
 )
 (setvar "cmdecho"   SUCE)
 (setvar "orthomode" SUOM)
 (setvar "osmode"    SUSM)
 (setvar "angbase"   SUAB)
 (setvar "angdir"    SUAD)
 (princ "\nError, Restoring Variables.")
 (terpri)
 (setq *error* temperr)
 (princ)
)
;
;//////////////////////////////////////////////////////////////////////////

DCL

ESS : dialog {                                   //*dialog name
        label = "Drainage";           //*give it a label
: row {                                    //*define row
             : paragraph {                          //*define paragraph
              : text_part {                        //*define more text
                label = "Existing Storm Sewer";           //*some more text
              }                                    //*end text
              : text_part {                        //*define more text
                label = "to be removed";           //*some more text
              }                                    //*end text
              : text_part {                        //*define more text
                label = " ";           //*some more text
              }                                    //*end text
            }                                      //*end paragraph
        }                                          //*end row
        //: row {                                    //*define row
         //: boxed_column {                         //*define boxex_column
            //label = "Choose a Type";               //*give it a label 
            //: popup_list {                         //*define popup_list
             // key = "T1";                          //*give it a name
             // label = "Type";                      //*give it a label 
              //edit_width=8;                        //*edit_width
              //alignment = right;                   //*alignment
            //}                                      //*end popup_list
            //: spacer {                             //*define spacer
             // height = 0;                          //*height
            //}                                      //*end spacer
          //}                                        //*end column
       // }                                          //*end row
        : row {                                    //*define row
          : boxed_column {                         //*define boxex_column
            label = "Choose a Size";               //*give it a label 
            : popup_list {                         //*define popup_list
              key = "S1";                          //*give it a name
              label = "Size";                      //*give it a label 
              edit_width=8;                        //*edit_width
              alignment = right;                   //*alignment
            }                                      //*end popup_list
            : spacer {                             //*define spacer
              height = 0;                          //*height
            }                                      //*end spacer
          }                                        //*end boxed_column
        }                                          //*end row
        //: row {                                    //*define row
          //: boxed_column {                         //*define boxex_column
            //label = "Set Line Width";              //*give it a label 
            //: edit_box {                           //*define edit_box
              //key = "P1";                          //*give it a name
             //label = "Line Width";                //*give it a label 
              //edit_width=8;                        //*edit_width
              //alignment = right;                   //*alignment
            //}                                      //*end popup_list
            //: spacer {                             //*define spacer
             // height = 0;                          //*height
            //}                                      //*end spacer
          //}                                        //*end boxed_column
        //}                                          //*end row
        : row {                                    //*define row
          : column {                               //*define column
            ok_cancel ;                            //*predifined OK/Cancel
            : paragraph {                          //*define paragraph
               : text_part {                        //*define more text
                label = "CCC NNRDO     v1.0.24.07.2009";           //*some more text
              }                                    //*end text
            }                                      //*end paragraph
          }                                        //*end column
        }                                          //*end row
      }                                            //*end dialog

July 28, 2009

Better yet, you do not have text in the lines, So more code was removed.

;//////////////////////////////////////////////////////////////////////////
;
; Start-Up Function
;
(defun C:ESS ()
 (POPUP_MF)
 (princ)
)
;
;//////////////////////////////////////////////////////////////////////////
;
; Main Function
;
(defun POPUP_MF (/ SIZE$ SIZE SUCE  SUOM  SUSM SUAB SUAD MIDPT PLEN
                  PT01  PT02 a b)
 (setq SUCE (getvar "cmdecho"))
 (setq SUOM (getvar "orthomode"))
 (setq SUSM (getvar "osmode"))
 (setq SUAB (getvar "angbase"))
 (setq SUAD (getvar "angdir"))
 (setq temperr *error*)
 (setq *error* ETRAP)
 (setq S1_list
  '("1500mm" "1350mm"
    "1200mm" "1050mm"
     "900mm"  "750mm"
     "675mm"  "600mm"
     "525mm"  "450mm"
     "375mm"  "300mm"
     "225mm"  "150mm"
   )
 )
 (setq dcl_id (load_dialog "ESS.dcl"))
 (if
   (not
     (new_dialog "ESS" dcl_id)
   )
   (progn
     (ALERT "Can not find your dcl file")
     (exit)
   )
 )
 (start_list "S1")
 (mapcar 'add_list S1_list)
 (end_list)
 (if SIZE:DEF
   (set_tile "S1" (itoa SIZE:DEF))
 )
 (action_tile "cancel"
  "(done_dialog)(setq userclick nil)"
 )
 (action_tile "accept"
   (strcat
    "(progn
     (setq S:IZE (atoi (get_tile \"S1\")) SIZE:DEF S:IZE)"
    "(done_dialog)(setq userclick T))"
   )
 )
 (start_dialog)
 (unload_dialog dcl_id)
 (if userclick
   (VARIABLE)
 )
 (princ)
)
;
;//////////////////////////////////////////////////////////////////////////
;
; Variable Function
;
(defun VARIABLE ()
 (progn 
   (setq SIZE$ (fix S:IZE))
   (setq SIZE$ (nth S:IZE S1_list))
   (cond
     ((= SIZE$ "1500mm")(setq SIZE$ "1500"))
     ((= SIZE$ "1350mm")(setq SIZE$ "1350"))
     ((= SIZE$ "1200mm")(setq SIZE$ "1200"))
     ((= SIZE$ "1050mm")(setq SIZE$ "1050"))
     ((= SIZE$  "900mm")(setq SIZE$  "900"))
     ((= SIZE$  "750mm")(setq SIZE$  "750"))
     ((= SIZE$  "675mm")(setq SIZE$  "675"))
     ((= SIZE$  "600mm")(setq SIZE$  "600"))
     ((= SIZE$  "525mm")(setq SIZE$  "525"))
     ((= SIZE$  "450mm")(setq SIZE$  "450"))
     ((= SIZE$  "375mm")(setq SIZE$  "375"))
     ((= SIZE$  "300mm")(setq SIZE$  "300"))
     ((= SIZE$  "225mm")(setq SIZE$  "225"))
     ((= SIZE$  "150mm")(setq SIZE$  "150"))
   )
 )
 (setq SIZE SIZE$) 
 (OUTPUT)
 (princ)
)
;
;//////////////////////////////////////////////////////////////////////////
;
; Output Function
;
(defun OUTPUT ()
 (setq a (strcat "CCC_DR_"SIZE)
       b (strcat "CCC_SERVICES_EXISTING_Drainage_Storm_Sewer_"SIZE)
 )
 (if
   (not
     (tblsearch "LTYPE" a)
   )
   (command "_.-linetype" "_l" a "CCC_Drainage.lin" "")
 )
 (command "_.-layer" "_N" b "_M" b "_L" a b "_C" "84" b "_LW" "0.3" b "" )
 (setvar "angbase" 0.0000)
 (setvar "angdir"  0)
 (setvar "orthomode" 0)
 (setvar "osmode"    16383)
 (setq PT01 (getpoint "\nEnter the line start point:"))
 (while
   (/= nil
     (setq PT02 (getpoint pt01 "\nEnter the line end point:"))
   )
   (setvar "osmode" 0)
   (command "_.pline" PT01 PT02 "")
   (setq PT01 PT02)
   (setvar "osmode" 16383)
 )
 (setq *error* temperr)
 (setvar "cmdecho"   SUCE)
 (setvar "orthomode" SUOM)
 (setvar "osmode"    SUSM)
 (setvar "angbase"   SUAB)
 (setvar "angdir"    SUAD)
 (princ)
)
;
;//////////////////////////////////////////////////////////////////////////
;
; Error Trap Function
;
(defun ETRAP (errmsg)
 (command nil nil nil)
 (if
   (not
     (member errmsg '("console break" "Function Cancelled"))
   )
   (princ (strcat "\nError:" errmsg))
 )
 (setvar "cmdecho"   SUCE)
 (setvar "orthomode" SUOM)
 (setvar "osmode"    SUSM)
 (setvar "angbase"   SUAB)
 (setvar "angdir"    SUAD)
 (princ "\nError, Restoring Variables.")
 (terpri)
 (setq *error* temperr)
 (princ)
)
;
;//////////////////////////////////////////////////////////////////////////

July 28, 2009

woodman78,

I assume you are making different codes for each group of custom linetypes. I hope you realize that all the linetypes can be done in one code. I believe all you really need to do is establish group category variables and some additional conditions. If you would like me to set this up for you, It would really be no bother to me at all.

Its upto you. Please let me know.

The Buzzard

July 28, 2009

woodman78,

I assume you are making different codes for each group of custom linetypes. I hope you realize that all the linetypes can be done in one code. I believe all you really need to do is establish group category variables and some additional conditions. If you would like me to set this up for you, It would really be no bother to me at all.

Its upto you. Please let me know.

The Buzzard

Ah what the heck. I did it anyway. Just make sure you use both of these files. Changes were done in the dcl and lsp.

I also put in a new layer function that takes into account if the layer is frozen to thaw it.

ESS.zip

July 28, 2009

Sorry woodman78,

I got too far ahead of myself.

1. Forgot to add the lines that are highlighted in red. (See the code below)

2. The program will draw all linetypes listed in your line file.

3. I also added comments in the code thats in the attached zip file.

4. A new layer function was added as I previously mentioned.

5. A mode_tile function was added to clarify and avoid selection mistakes as well as two radio_buttons for the line categories.

6. The functions in the code were named uniquely to be specific to this code to avoid conflict problems with other codes.

7. When the program loads it will display a message at the command prompt that the program is loaded and how to start it.

8. I removed the line width as you requested.

Please use the lisp and dialog provided in the zip file.

Also below are images of the dialog.

Anything else you may need, Just mention it.

Good Luck,

The Buzzard

;//////////////////////////////////////////////////////////////////////////
;
; Start-Up Function
;
(defun C:ESS ()
 (ESS_MF)
 (princ)
)
(princ "\nESS.lsp Loaded....")
(princ "\nType ESS to start program.")
;
;//////////////////////////////////////////////////////////////////////////
;
; Main Function
;
(defun ESS_MF (/ HOLE$ SIZE$ HOLE SIZE PWID LCAT SUCE  SUOM  SUSM SUAB SUAD
                MIDPT PLEN  PT01 PT02 a b c d)
 (setq SUCE (getvar "cmdecho"))
 (setq SUOM (getvar "orthomode"))
 (setq SUSM (getvar "osmode"))
 (setq SUAB (getvar "angbase"))
 (setq SUAD (getvar "angdir"))
 (setq temperr *error*)
 (setq *error* ESS_ET)
 (or L:CAT (setq L:CAT "C1"))
 (setq T1_list
  '("Type A" "Type B"
    "Type C" "Type D"
    "Type 1" "Type 2"
    "Type 3" "Type 4"
   )
 )
 (setq S1_list
  '("1500mm" "1350mm"
    "1200mm" "1050mm"
     "900mm"  "750mm"
     "675mm"  "600mm"
     "525mm"  "450mm"
     "375mm"  "300mm"
     "225mm"  "150mm"
   )
 )
 (setq dcl_id (load_dialog "ESS.dcl"))
 (if
   (not
     (new_dialog "ESS" dcl_id)
   )
   (progn
     (ALERT "Can not find your dcl file")
     (exit)
   )
 )
 (start_list "T1")
 (mapcar 'add_list T1_list)
 (end_list)
 (start_list "S1")
 (mapcar 'add_list S1_list)
 (end_list)
 (set_tile L:CAT "1")
 (ESS_MT L:CAT)
 (action_tile "C1"
  "(ESS_MT (setq L:CAT \"C1\"))"
 )
 (action_tile "C2"
  "(ESS_MT (setq L:CAT \"C2\"))"
 )
 (if HOLE:DEF
   (set_tile "T1" (itoa HOLE:DEF))
 )
 (if SIZE:DEF
   (set_tile "S1" (itoa SIZE:DEF))
 )
 (action_tile "cancel"
  "(done_dialog)(setq userclick nil)"
 )
 (action_tile "accept"
   (strcat
    "(progn
     (setq H:OLE (atoi (get_tile \"T1\")) HOLE:DEF H:OLE)"
    "(setq S:IZE (atoi (get_tile \"S1\")) SIZE:DEF S:IZE)"
    "(done_dialog)(setq userclick T))"
   )
 )
 (start_dialog)
 (unload_dialog dcl_id)
 (if userclick
   (ESS_VF)
 )
 (princ)
)
;
;//////////////////////////////////////////////////////////////////////////
;
; Variable Function
;
(defun ESS_VF ()
 (progn
   (setq HOLE$ (fix H:OLE))
   (setq HOLE$ (nth H:OLE T1_list))
   (cond
[color=red]      ((= HOLE$ "Type A"))[/color]
[color=red]      ((= HOLE$ "Type B"))[/color]
[color=red]      ((= HOLE$ "Type C"))[/color]
[color=red]      ((= HOLE$ "Type D"))[/color]
     ((= HOLE$ "Type 1"))
     ((= HOLE$ "Type 2"))
     ((= HOLE$ "Type 3"))
     ((= HOLE$ "Type 4"))
   )
 )
 (setq HOLE HOLE$)
 (progn 
   (setq SIZE$ (fix S:IZE))
   (setq SIZE$ (nth S:IZE S1_list))
   (cond
     ((= SIZE$ "1500mm")(setq SIZE$ "1500"))
     ((= SIZE$ "1350mm")(setq SIZE$ "1350"))
     ((= SIZE$ "1200mm")(setq SIZE$ "1200"))
     ((= SIZE$ "1050mm")(setq SIZE$ "1050"))
     ((= SIZE$  "900mm")(setq SIZE$  "900"))
     ((= SIZE$  "750mm")(setq SIZE$  "750"))
     ((= SIZE$  "675mm")(setq SIZE$  "675"))
     ((= SIZE$  "600mm")(setq SIZE$  "600"))
     ((= SIZE$  "525mm")(setq SIZE$  "525"))
     ((= SIZE$  "450mm")(setq SIZE$  "450"))
     ((= SIZE$  "375mm")(setq SIZE$  "375"))
     ((= SIZE$  "300mm")(setq SIZE$  "300"))
     ((= SIZE$  "225mm")(setq SIZE$  "225"))
     ((= SIZE$  "150mm")(setq SIZE$  "150"))
   )
 )
 (setq SIZE SIZE$) 
 (setq LCAT L:CAT)
 (ESS_OF)
 (princ)
)
;
;//////////////////////////////////////////////////////////////////////////
;
; Output Function
;
(defun ESS_OF ()
 (setq c "84")
 (setq d "0.3")
 (if
   (= LCAT "C1")
   (setq a (strcat "CCC_DR_"SIZE"_"HOLE)
         b (strcat "CCC_SERVICES_EXISTING_Drainage_Storm_Sewer_"SIZE"_"HOLE)
   )
 )
 (if
   (= LCAT "C2")
   (setq a (strcat "CCC_DR_"SIZE)
         b (strcat "CCC_SERVICES_EXISTING_Drainage_Storm_Sewer_"SIZE)
   )
 )
 (if
   (not
     (tblsearch "LTYPE" a)
   )
   (command "_.-linetype" "_l" a "CCC_Drainage.lin" "")
 )
 (ESS_LC b c a d)
 (setvar "angbase" 0.0000)
 (setvar "angdir"  0)
 (setvar "orthomode" 1)
 (setvar "osmode"    16383)
 (setq PT01 (getpoint "\nEnter the line start point:"))
 (while
   (/= nil
     (setq PT02 (getpoint PT01 "\nEnter the line end point:"))
   )
   (setvar "osmode" 0)
   (if
     (= LCAT "C1")
     (progn
       (command "_.pline" PT01 PT02 "")
       (setq RADIANS (angle PT01 PT02))
       (setq DEGREES (ESS_RTD RADIANS))
       (setq PLEN (distance PT01 PT02))
       (setq MIDPT (polar PT01 (ESS_DTR DEGREES)(/ PLEN 2.0)))
       (setq PT01 PT02)
       (setvar "osmode" 16383)
       (if
         (and
           (>  DEGREES 90.0)
           (<= DEGREES 270.0)
         )
         (command "_.rotate" "last" "" MIDPT "180.0")
       )
     )
   )
   (if
     (= LCAT "C2")
     (progn
       (command "_.pline" PT01 PT02 "")
       (setq PT01 PT02)
       (setvar "osmode" 16383)
     )
   )
 )
 (setq *error* temperr)
 (setvar "cmdecho"   SUCE)
 (setvar "orthomode" SUOM)
 (setvar "osmode"    SUSM)
 (setvar "angbase"   SUAB)
 (setvar "angdir"    SUAD)
 (princ)
)
;
;//////////////////////////////////////////////////////////////////////////
;
; Mode_Tile Function
;
(defun ESS_MT (L:CAT)
 (cond
   ((= L:CAT "C1")(mode_tile "T1" 0)(mode_tile "S1" 0))
   ((= L:CAT "C2")(mode_tile "T1" 1)(mode_tile "S1" 0))
 )
 (princ)
)
;
;//////////////////////////////////////////////////////////////////////////
;
; Degrees to Radians Function
;
(defun ESS_DTR (DEGREES)
(* pi (/ DEGREES 180.0))
)
;
;//////////////////////////////////////////////////////////////////////////
;
; Radians to Degrees Function
;
(defun ESS_RTD (RADIANS)
 (* 180.0 (/ RADIANS pi))
)
;
;//////////////////////////////////////////////////////////////////////////
;
; Layer Create Function
;
(defun ESS_LC (NLAY LCLR LTYP LWGT / LAY FRZ)
;
 (setq CLAY (getvar "clayer"))
 (setq LAY (tblsearch "layer" NLAY))
 (if
   (not LAY)
   (command "_.layer" "m" NLAY "c" LCLR "" "lt" LTYP "" "lw" LWGT "" "")
   (progn
     (setq FRZ (cdr (assoc 70 LAY)))
     (if
       (= FRZ 65)
       (progn
         (command "_.layer" "t" NLAY "")
         (command "_.layer" "s" NLAY "")
       )
       (command "_.layer" "s" NLAY "")
     )
   )
 )
 (princ)
)
;
;//////////////////////////////////////////////////////////////////////////;
;
; Error Trap Function
;
(defun ESS_ET (errmsg)
 (command nil nil nil)
 (if
   (not
     (member errmsg '("console break" "Function Cancelled"))
   )
   (princ (strcat "\nError:" errmsg))
 )
 (setvar "cmdecho"   SUCE)
 (setvar "orthomode" SUOM)
 (setvar "osmode"    SUSM)
 (setvar "angbase"   SUAB)
 (setvar "angdir"    SUAD)
 (princ "\nError, Restoring Variables.")
 (terpri)
 (setq *error* temperr)
 (princ)
)
;
;//////////////////////////////////////////////////////////////////////////

ESS.zip

July 29, 2009

Thanks for that Buzzard. I wasn't aware that you could combine the linetypes into the lsp. The issue I have is that some of the pipes will have types and others won't so I don't want to leave it up to the user to choose. That is why I wanted 1 version with the types and one version without. I will make a command and a ribbon button for each pipe.

Thanks again anyway.

July 29, 2009

Thanks for that Buzzard. I wasn't aware that you could combine the linetypes into the lsp. The issue I have is that some of the pipes will have types and others won't so I don't want to leave it up to the user to choose. That is why I wanted 1 version with the types and one version without. I will make a command and a ribbon button for each pipe.

Thanks again anyway.

No problem, But you will find that this code is just as easy to use. I took portions of it from one of my older codes to save some time. It seems to work very well. The error trapping makes it work almost flawless. Put it thru some trials and see how it goes.

March 31, 2010

Buzzard,

This one hasn't been around for a while but we started using this on a project and have run into some issues. You set it up so that the text in the linetype will alwaya run the same way. The problem we have is where we use short lengths then no linetype is visible. I have been playing around over the last few days to try to remove the section that rotates the line and use the command with a single multi vertex polyline with linetype generation enabled. Can you have a look? I keep getting "cmdecho" errors and "extra right paren on input" errors.

Thanks.

PDISSAT.dcl

PDISSAT.lsp

CCC_Drainage.txt

March 31, 2010

Buzzard,

This one hasn't been around for a while but we started using this on a project and have run into some issues. You set it up so that the text in the linetype will alwaya run the same way. The problem we have is where we use short lengths then no linetype is visible. I have been playing around over the last few days to try to remove the section that rotates the line and use the command with a single multi vertex polyline with linetype generation enabled. Can you have a look? I keep getting "cmdecho" errors and "extra right paren on input" errors.

Thanks.

I noticed you are saving cmdecho and restoring, However you are not setting it anywhere. The program is not giving me this error or extra right paren.

With regard to the smaller line sizes, You need to adjust you linetype definitions.

You also are not doing a tablsearch for your layers as the program displays the message at the prompt. I also recall showing you a different way to deal with the layers.

As far as I know, I did not work on this program with you as this is a different rewrite of what was posted here.

At this stage I am using different methods such as entmakex. I would recommend you look into this as a better alternative to the command call.

March 31, 2010

Here is an entity make method for rotating complex linetypes. It does not have a DCL since I wanted to keep this one simple. It does basically the same thing without all the command calls. You can add a DCL to it if you want. The program uses the command call just to load the linetypes since you cannot entmake a complex linetype.

Just trying to give you a different approach.

For more information on entity make, See this thread:

http://www.cadtutor.net/forum/showthread.php?t=44768&highlight=entmake

COMPLEX.lsp

March 31, 2010

woodman78

Attached is your program with a few minor fixes. I did notice you used entmake to create the font style.

Why stop there?

1. Anyway I fixed the layer issue layer MAKE instead of NEW.

2. Changed plinewid from a command call to setvar and also had it restore the user plinewid.

3. Added cmdecho to be set to 0.

4. Your entmake function for textstyle should be after you select OK and I also put in tablesearch for this as well.

I do not see any problems with this now, But I have not spotted the issues you were referring to.

Again, I think you can do this in entmake as shown in the Complex.lsp. You already made an attempt with the font style, So finish the rest. It will be a much better improvement.

;//////////////////////////////////////////////////////////////////////////
;
; Start-Up Function
;
(defun C:PDISSAT ()
 (PDISSAT_MF)
 (princ))
;
;//////////////////////////////////////////////////////////////////////////
;
; Main Function
;
(defun PDISSAT_MF (/ HOLE$ SIZE$ HOLE SIZE PWID SUCE SUOM SUSM SUAB SUAD SUPW MIDPT PLEN PT01 PT02 a b)
 (setq SUCE (getvar "cmdecho"))
 (setq SUOM (getvar "orthomode"))
 (setq SUSM (getvar "osmode"))
 (setq SUAB (getvar "angbase"))
 (setq SUAD (getvar "angdir"))
 (setq SUCL (getvar "clayer"))
 (setq SUCR (getvar "cecolor"))
 [color=red](setq SUPW (getvar "plinewid"))[/color]
 (setq temperr *error*)
 (setq *error* PDISSAT_ETRAP)
 (setq T1_list '("Type 1" "Type 2" "Type 3" "Type 4"))
 (setq S1_list '( "600mm" "525mm" "450mm" "375mm" "300mm" "225mm" "150mm"))
 (setq dcl_id (load_dialog "PDISSAT.dcl"))
 (if (not (new_dialog "PDISSAT" dcl_id))
   (progn (ALERT "Can not find your dcl file")
     (exit)))
 (start_list "T1")
 (mapcar 'add_list T1_list)
 (end_list)
 (start_list "S1")
 (mapcar 'add_list S1_list)
 (end_list)
 (if HOLE:DEF (set_tile "T1" (itoa HOLE:DEF)))
 (if SIZE:DEF (set_tile "S1" (itoa SIZE:DEF)))
 (action_tile "cancel" "(done_dialog)(setq userclick nil)")
 (action_tile "accept"
   (strcat
    "(progn
     (setq H:OLE (atoi (get_tile \"T1\")) HOLE:DEF H:OLE)"
    "(setq S:IZE (atoi (get_tile \"S1\")) SIZE:DEF S:IZE)"
    "(done_dialog)(setq userclick T))"))
 (start_dialog)
 (unload_dialog dcl_id)
 (if userclick
   (PDISSAT_VARIABLE))
 (princ))
;
;//////////////////////////////////////////////////////////////////////////
;
; PDISSAT_VARIABLE Function
;
(defun PDISSAT_VARIABLE ()
 (progn
   (setq HOLE$ (fix H:OLE))
   (setq HOLE$ (nth H:OLE T1_list))
   (cond
     ((= HOLE$ "Type 1"))
     ((= HOLE$ "Type 2"))
     ((= HOLE$ "Type 3"))
     ((= HOLE$ "Type 4"))))
 (setq HOLE HOLE$)
 (progn 
   (setq SIZE$ (fix S:IZE))
   (setq SIZE$ (nth S:IZE S1_list))
   (cond
     ((= SIZE$  "600mm")(setq SIZE$  "600"))
     ((= SIZE$  "525mm")(setq SIZE$  "525"))
     ((= SIZE$  "450mm")(setq SIZE$  "450"))
     ((= SIZE$  "375mm")(setq SIZE$  "375"))
     ((= SIZE$  "300mm")(setq SIZE$  "300"))
     ((= SIZE$  "225mm")(setq SIZE$  "225"))
     ((= SIZE$  "150mm")(setq SIZE$  "150"))))
 (setq SIZE SIZE$) 
 (PDISSAT_OUTPUT)
 (princ))
;
;//////////////////////////////////////////////////////////////////////////
;
; PDISSAT_OUTPUT Function
;
(defun PDISSAT_OUTPUT ()
[color=red]  (if (not (tblsearch "STYLE" "CCC_Services"))[/color]
[color=red]    (entmake[/color]
[color=red]      (list[/color]
[color=red]        (cons 0 "STYLE")[/color]
[color=red]        (cons 100 "AcDbSymbolTableRecord")[/color]
[color=red]        (cons 100 "AcDbTextStyleTableRecord")[/color]
[color=red]        (cons 2 "CCC_Services")[/color]
[color=red]        (cons 3 "Verdana.ttf")[/color]
[color=red]        (cons 40 0)[/color]
[color=red]        (cons 70 0))))[/color]
 (setq a (strcat "CCC_DR_"SIZE"_"HOLE)
       b (strcat "CCC_SERVICES_PROPOSED_Drainage_Storm_Sewer_Ductile_Iron_"SIZE"_"HOLE))
 (if (not (tblsearch "LTYPE" a))
   (command "_.-linetype" "_l" a "CCC_Drainage.lin" ""))
 (command "_.-layer" [color=red]"_M"[/color] b "_M" b "_L" a b "_C" "30" b "_LW" "0.3" b "" )
 [color=red](setvar "cmdecho" 0)[/color]
 (setvar "angbase" 0.0000)
 (setvar "angdir"  0)
 (setvar "orthomode" 0)
 (setvar "osmode"    16383)
 [color=red](setvar "plinewid" 0.3)[/color]
 (setq PT01 (getpoint "\nEnter the line start point:"))
 (while
   (/= nil (setq PT02 (getpoint pt01 "\nEnter the line end point:")))
   (setvar "osmode" 0)
   (command "_.pline" PT01 PT02 "")
   (setq RADIANS (angle PT01 PT02))
   (setq DEGREES (PDISSAT_RTD RADIANS))
   (setq PLEN (distance PT01 PT02))
   (setq MIDPT (polar PT01 (PDISSAT_DTR DEGREES)(/ PLEN 2.0)))
   (setq PT01 PT02)
   (setvar "osmode" 16383)
   (if (and (>  DEGREES 90.0)(<= DEGREES 270.0))
     (command "_.rotate" "last" "" MIDPT "180.0")))
 (setq *error* temperr)
 (setvar "cmdecho"   SUCE)
 (setvar "orthomode" SUOM)
 (setvar "osmode"    SUSM)
 (setvar "angbase"   SUAB)
 (setvar "angdir"    SUAD)
 (setvar "clayer"    SUCL)
 (setvar "cecolor"   SUCR)
 ([color=red]setvar "plinewid"  SUPW)[/color]
 (princ))
;
;//////////////////////////////////////////////////////////////////////////
;
; Degrees to Radians Function
;
(defun PDISSAT_DTR (DEGREES)
(* pi (/ DEGREES 180.0)))
;
;//////////////////////////////////////////////////////////////////////////
;
; Radians to Degrees Function
;
(defun PDISSAT_RTD (RADIANS)
 (* 180.0 (/ RADIANS pi)))
;
;//////////////////////////////////////////////////////////////////////////
;
; Error Trap Function
;
(defun PDISSAT_ETRAP (errmsg)
 (command nil nil nil)
 (if (not (member errmsg '("console break" "Function Cancelled")))
   (princ (strcat "\nError:" errmsg)))
 (setvar "cmdecho"   SUCE)
 (setvar "orthomode" SUOM)
 (setvar "osmode"    SUSM)
 (setvar "angbase"   SUAB)
 (setvar "angdir"    SUAD)
 (setvar "clayer"    SUCL)
 (setvar "cecolor"   SUCR)
 [color=red](setvar "plinewid"  SUPW)[/color]
 (princ "\nError, Restoring PDISSAT_VARIABLEs.")
 (terpri)
 (setq *error* temperr)
 (princ))
;
;//////////////////////////////////////////////////////////////////////////

April 1, 2010

Buzzard, I have tried to put in the entmake for Layer but it doesn't work. I have also commented out the sections that rotate the pline so that the text is in the same direction. I need to use the single pline with linetype generation because somtimes line lengths are so short that the linetype doesn't display and making the scale smaller isn't an option either.

Can you take a look please? I got it to create the layer using the command as I had it but when i go to draw the pline it reverts back to layer 0.

Thanks.

 
;//////////////////////////////////////////////////////////////////////////
;
; Start-Up Function
;
(defun C:PDISSAT ()
 (PDISSAT_MF)
 (princ))
;
;//////////////////////////////////////////////////////////////////////////
;
; Main Function
;
(defun PDISSAT_MF (/ HOLE$ SIZE$ HOLE SIZE PWID SUCE SUOM SUSM SUAB SUAD SUPW MIDPT PLEN PT01 PT02 a b)
 (setq SUCE (getvar "cmdecho"))
 (setq SUOM (getvar "orthomode"))
 (setq SUSM (getvar "osmode"))
 (setq SUAB (getvar "angbase"))
 (setq SUAD (getvar "angdir"))
 (setq SUCL (getvar "clayer"))
 (setq SUCR (getvar "cecolor"))
 (setq SUPW (getvar "plinewid"))
 (setq temperr *error*)
 (setq *error* PDISSAT_ETRAP)
 (setq T1_list '("Type 1" "Type 2" "Type 3" "Type 4"))
 (setq S1_list '( "600mm" "525mm" "450mm" "375mm" "300mm" "225mm" "150mm"))
 (setq dcl_id (load_dialog "PDISSAT.dcl"))
 (if (not (new_dialog "PDISSAT" dcl_id))
   (progn (ALERT "Can not find your dcl file")
     (exit)))
 (start_list "T1")
 (mapcar 'add_list T1_list)
 (end_list)
 (start_list "S1")
 (mapcar 'add_list S1_list)
 (end_list)
 (if HOLE:DEF (set_tile "T1" (itoa HOLE:DEF)))
 (if SIZE:DEF (set_tile "S1" (itoa SIZE:DEF)))
 (action_tile "cancel" "(done_dialog)(setq userclick nil)")
 (action_tile "accept"
   (strcat
    "(progn
     (setq H:OLE (atoi (get_tile \"T1\")) HOLE:DEF H:OLE)"
    "(setq S:IZE (atoi (get_tile \"S1\")) SIZE:DEF S:IZE)"
    "(done_dialog)(setq userclick T))"))
 (start_dialog)
 (unload_dialog dcl_id)
 (if userclick
   (PDISSAT_VARIABLE))
 (princ))
;
;//////////////////////////////////////////////////////////////////////////
;
; PDISSAT_VARIABLE Function
;
(defun PDISSAT_VARIABLE ()
 (progn
   (setq HOLE$ (fix H:OLE))
   (setq HOLE$ (nth H:OLE T1_list))
   (cond
     ((= HOLE$ "Type 1"))
     ((= HOLE$ "Type 2"))
     ((= HOLE$ "Type 3"))
     ((= HOLE$ "Type 4"))))
 (setq HOLE HOLE$)
 (progn 
   (setq SIZE$ (fix S:IZE))
   (setq SIZE$ (nth S:IZE S1_list))
   (cond
     ((= SIZE$  "600mm")(setq SIZE$  "600"))
     ((= SIZE$  "525mm")(setq SIZE$  "525"))
     ((= SIZE$  "450mm")(setq SIZE$  "450"))
     ((= SIZE$  "375mm")(setq SIZE$  "375"))
     ((= SIZE$  "300mm")(setq SIZE$  "300"))
     ((= SIZE$  "225mm")(setq SIZE$  "225"))
     ((= SIZE$  "150mm")(setq SIZE$  "150"))))
 (setq SIZE SIZE$) 
 (PDISSAT_OUTPUT)
 (princ))
;
;//////////////////////////////////////////////////////////////////////////
;
; PDISSAT_OUTPUT Function
;
(defun PDISSAT_OUTPUT ()
 (if (not (tblsearch "STYLE" "CCC_Services"))
   (entmake
     (list
       (cons 0 "STYLE")
       (cons 100 "AcDbSymbolTableRecord")
       (cons 100 "AcDbTextStyleTableRecord")
       (cons 2 "CCC_Services")
       (cons 3 "Verdana.ttf")
       (cons 40 0)
       (cons 70 0))))

 (setq a (strcat "CCC_DR_"SIZE"_"HOLE)
       b (strcat "CCC_SERVICES_PROPOSED_Drainage_Storm_Sewer_Ductile_Iron_"SIZE"_"HOLE))
 (if (not (tblsearch "LTYPE" a))
   (command "_.-linetype" "_l" a "CCC_Drainage.lin" ""))
   ;(command "_.-layer" "_M" b "_M" b "_L" a b "_C" "30" b "_LW" "0.3" b "" )
 (if (not (tblsearch "LAYER" b))
   (entmake
     (list
       (cons 0 "LAYER")
       (cons 100 "AcDbSymbolTableRecord")
       (cons 100 "AcDbLayerTableRecord")
       (cons 2 b)
       (cons 6 a)
       (cons 62 30))))
(setvar "cmdecho" 0)
 (setvar "angbase" 0.0000)
 (setvar "angdir"  0)
 (setvar "orthomode" 0)
 (setvar "osmode"    16383)
 (setvar "plinewid" 0.3)
 ;(setq PT01 (getpoint "\nEnter the line start point:"))
 ;(while
   ;(/= nil (setq PT02 (getpoint pt01 "\nEnter the line end point:")))
   (setvar "osmode" 0)
   (setvar "plinegen" 1)
   (command "_.pline")
   ;(command "_.pline" PT01 PT02 "")
   ;(setq RADIANS (angle PT01 PT02))
   ;(setq DEGREES (PDISSAT_RTD RADIANS))
   ;(setq PLEN (distance PT01 PT02))
   ;(setq MIDPT (polar PT01 (PDISSAT_DTR DEGREES)(/ PLEN 2.0)))
   ;(setq PT01 PT02)
   (setvar "osmode" 16383)
   ;(if (and (>  DEGREES 90.0)(<= DEGREES 270.0))
     ;(command "_.rotate" "last" "" MIDPT "180.0")))
 (setq *error* temperr)
 (setvar "cmdecho"   SUCE)
 (setvar "orthomode" SUOM)
 (setvar "osmode"    SUSM)
 (setvar "angbase"   SUAB)
 (setvar "angdir"    SUAD)
 (setvar "clayer"    SUCL)
 (setvar "cecolor"   SUCR)
 (setvar "plinewid"  SUPW)
 (princ))
;
;//////////////////////////////////////////////////////////////////////////
;
; Degrees to Radians Function
;
(defun PDISSAT_DTR (DEGREES)
(* pi (/ DEGREES 180.0)))
;
;//////////////////////////////////////////////////////////////////////////
;
; Radians to Degrees Function
;
(defun PDISSAT_RTD (RADIANS)
 (* 180.0 (/ RADIANS pi)))
;
;//////////////////////////////////////////////////////////////////////////
;
; Error Trap Function
;
(defun PDISSAT_ETRAP (errmsg)
 (command nil nil nil)
 (if (not (member errmsg '("console break" "Function Cancelled")))
   (princ (strcat "\nError:" errmsg)))
 (setvar "cmdecho"   SUCE)
 (setvar "orthomode" SUOM)
 (setvar "osmode"    SUSM)
 (setvar "angbase"   SUAB)
 (setvar "angdir"    SUAD)
 (setvar "clayer"    SUCL)
 (setvar "cecolor"   SUCR)
 (setvar "plinewid"  SUPW)
 (princ "\nError, Restoring PDISSAT_VARIABLEs.")
 (terpri)
 (setq *error* temperr)
 (princ))
;
;//////////////////////////////////////////////////////////////////////////

April 1, 2010

Thats because you need entmake for the pline as well.

It is creating the layer, Just not setting it.

Notice cons 8 below.

This is where the layer is set.

If you are going there, Then go all the way.

Review the Complex.lsp completely. I will be happy to answer all your questions.

Example:

(defun MAKE_PLINE ()
 (setq STRPT (getpoint "\nSpecify line starting point: "))
 (while
   (/= nil (setq ENDPT (getpoint STRPT "\nSpecify line ending point: ")))
   (setq RADIANS (angle STRPT ENDPT)
         DEGREES (RTD RADIANS))
   (if (and (> DEGREES 90)(<= DEGREES 270))
     (entmakex
       (list
         (cons 0 "LWPOLYLINE")
         (cons 100 "AcDbEntity")
        [color=red](cons 8 LNAM)  ; or in yourcase b[/color]
         (cons 100 "AcDbPolyline")
         (cons 90 2)
         (cons 70 0)
         (cons 10 ENDPT)
         (cons 10 STRPT))))
   (if (or (<= DEGREES 90)(> DEGREES 270))
     (entmakex
       (list
         (cons 0 "LWPOLYLINE")
         (cons 100 "AcDbEntity")
         [color=red](cons 8 LNAM) ; or in your case b[/color]
         (cons 100 "AcDbPolyline")
         (cons 90 2)
         (cons 70 0)
         (cons 10 STRPT)
         (cons 10 ENDPT))))
   (setq STRPT ENDPT))
 (RESTORE_USER_SETTINGS)
 (princ))

April 1, 2010

Let me know how this works out.

I used the coding from the Complex.lsp and made the variable and function adjustments. May need to be fine tuned and maybe not. I tested it and this program does not have any issues with making the pline very small.

The only command call in here is to load the linetypes.

Just also want to point out that removing the rotation will not solve any issue with short lines displaying correctly.

Since this is an entmake code, The line should still show even if its size is too small to show the text.

If you feel that you still want this removed after running this code, Then let me know and I will take it out.

PDISSAT.lsp with polyline rotated

;//////////////////////////////////////////////////////////////////////////
;
; Start-Up Function
;
(defun C:PDISSAT (/ HOLE$ SIZE$ HOLE SIZE PT01 PT02 a b lw DEGREES RADIANS)
 (PDISSAT_SAVE)
 (princ))
;
;//////////////////////////////////////////////////////////////////////////
;
; Save User Settings Function.
;
(defun PDISSAT_SAVE (/ SUS)
 (setq SUS_LIST (list "cmdecho" "orthomode" "osmode" "blipmode" "clayer" "angbase" "angdir" "cecolor"))
 (setq SUS (mapcar 'getvar SUS_LIST))
 (setq TERR$ *error*)
 (setq *error* PDISSAT_ETRAP)
 (PDISSAT_MF)
 (princ))
;
;//////////////////////////////////////////////////////////////////////////
;
; Main Function
;
(defun PDISSAT_MF ()
 (setq T1_list '("Type 1" "Type 2" "Type 3" "Type 4"))
 (setq S1_list '( "600mm" "525mm" "450mm" "375mm" "300mm" "225mm" "150mm"))
 (setq dcl_id (load_dialog "PDISSAT.dcl"))
 (if (not (new_dialog "PDISSAT" dcl_id))
   (progn (ALERT "Can not find your dcl file")
     (exit)))
 (start_list "T1")
 (mapcar 'add_list T1_list)
 (end_list)
 (start_list "S1")
 (mapcar 'add_list S1_list)
 (end_list)
 (if HOLE:DEF (set_tile "T1" (itoa HOLE:DEF)))
 (if SIZE:DEF (set_tile "S1" (itoa SIZE:DEF)))
 (action_tile "cancel" "(done_dialog)(setq userclick nil)")
 (action_tile "accept"
   (strcat
    "(progn
     (setq H:OLE (atoi (get_tile \"T1\")) HOLE:DEF H:OLE)"
    "(setq S:IZE (atoi (get_tile \"S1\")) SIZE:DEF S:IZE)"
    "(done_dialog)(setq userclick T))"))
 (start_dialog)
 (unload_dialog dcl_id)
 (if userclick
   (PDISSAT_VARIABLE))
 (princ))
;
;//////////////////////////////////////////////////////////////////////////
;
; PDISSAT_VARIABLE Function
;
(defun PDISSAT_VARIABLE ()
 (progn
   (setq HOLE$ (fix H:OLE))
   (setq HOLE$ (nth H:OLE T1_list))
   (cond
     ((= HOLE$ "Type 1"))
     ((= HOLE$ "Type 2"))
     ((= HOLE$ "Type 3"))
     ((= HOLE$ "Type 4"))))
 (setq HOLE HOLE$)
 (progn 
   (setq SIZE$ (fix S:IZE))
   (setq SIZE$ (nth S:IZE S1_list))
   (cond
     ((= SIZE$  "600mm")(setq SIZE$  "600"))
     ((= SIZE$  "525mm")(setq SIZE$  "525"))
     ((= SIZE$  "450mm")(setq SIZE$  "450"))
     ((= SIZE$  "375mm")(setq SIZE$  "375"))
     ((= SIZE$  "300mm")(setq SIZE$  "300"))
     ((= SIZE$  "225mm")(setq SIZE$  "225"))
     ((= SIZE$  "150mm")(setq SIZE$  "150"))))
 (setq SIZE SIZE$) 
 (PDISSAT_OUTPUT)
 (princ))
;
;//////////////////////////////////////////////////////////////////////////
;
; PDISSAT_OUTPUT Function
;
(defun PDISSAT_OUTPUT ()
 (if (null (tblsearch "STYLE" "CCC_Services"))
   (entmake
     (list
       (cons 0 "STYLE")
       (cons 100 "AcDbSymbolTableRecord")
       (cons 100 "AcDbTextStyleTableRecord")
       (cons 2 "CCC_Services")
       (cons 3 "Verdana.ttf")
       (cons 40 0)
       (cons 70 0))))
 (setq a  (strcat "CCC_DR_"SIZE"_"HOLE)
       b  (strcat "CCC_SERVICES_PROPOSED_Drainage_Storm_Sewer_Ductile_Iron_"SIZE"_"HOLE)
       lw 30)
 (if (null (tblsearch "LTYPE" a))
   (command "_.-linetype" "_l" a "CCC_Drainage.lin" ""))
 (if (null (tblsearch "LAYER" b))
   (entmake
     (list
       (cons 0 "LAYER")
       (cons 100 "AcDbSymbolTableRecord")
       (cons 100 "AcDbLayerTableRecord")
       (cons 2 b)
       (cons 6 a)
       (cons 62 30)
       (cons 70 0)
       (cons 370 lw))))
 (setvar "cmdecho" 0)
 (setvar "angbase" 0.0000)
 (setvar "angdir"  0)
 (setvar "orthomode" 0)
 (setvar "osmode"    16383)
 (setq PT01 (getpoint "\nEnter the line start point: "))
 (while
   (/= nil (setq PT02 (getpoint PT01 "\nEnter the line end point: ")))
   (setq RADIANS (angle PT01 PT02)
         DEGREES (PDISSAT_RTD RADIANS))
   (if (and (> DEGREES 90)(<= DEGREES 270))
     (entmakex
       (list
         (cons 0 "LWPOLYLINE")
         (cons 100 "AcDbEntity")
         (cons 8 b)
         (cons 100 "AcDbPolyline")
         (cons 90 2)
         (cons 70 0)
         (cons 10 PT02)
         (cons 10 PT01)
         (cons 43 0.3))))
   (if (or (<= DEGREES 90)(> DEGREES 270))
     (entmakex
       (list
         (cons 0 "LWPOLYLINE")
         (cons 100 "AcDbEntity")
         (cons 8 b)
         (cons 100 "AcDbPolyline")
         (cons 90 2)
         (cons 70 0)
         (cons 10 PT01)
         (cons 10 PT02)
         (cons 43 0.3))))
   (setq PT01 PT02))
 (PDISSAT_RESTORE)
 (princ))
;
;//////////////////////////////////////////////////////////////////////////
;
; Degrees to Radians Function
;
(defun PDISSAT_DTR (DEGREES)
(* pi (/ DEGREES 180.0)))
;
;//////////////////////////////////////////////////////////////////////////
;
; Radians to Degrees Function
;
(defun PDISSAT_RTD (RADIANS)
 (* 180.0 (/ RADIANS pi)))
;
;//////////////////////////////////////////////////////////////////////////
;
; Restore User Settings Function.
;
(defun PDISSAT_RESTORE ()
 (setq *error* TERR$)
 (if SUS (mapcar 'setvar SUS_LIST SUS))
 (princ "\nProgram completed and will now restore the user settings and exit.")
 (princ))
;
;/////////////////////////////////////////////////////////////////////////////
;
; Error Trap Function.
;
(defun PDISSAT_ETRAP (ERRORMSG)
 (command nil nil nil)
 (if (not (member ERRORMSG '("console break" "Function cancelled")))
   (princ (strcat "\nError:" ERRORMSG)))
 (if SUS (mapcar 'setvar SUS_LIST SUS))
 (princ "\nAn *error* has occured!")
 (princ "\nThe program will now restore the user settings and exit.")
 (terpri)
 (setq *error* TERR$)
 (princ))
;
;//////////////////////////////////////////////////////////////////////////

PDISSAT2.lsp without polyline rotated

;//////////////////////////////////////////////////////////////////////////
;
; Start-Up Function
;
(defun C:PDISSAT2 (/ HOLE$ SIZE$ HOLE SIZE PT01 PT02 a b lw DEGREES RADIANS)
 (PDISSAT_SAVE)
 (princ))
(princ "\nProposed Ductile Iron Storm Sewer 2 Lisp loaded...")
(princ "\nType PDISSAT2 to start.")
;
;//////////////////////////////////////////////////////////////////////////
;
; Save User Settings Function.
;
(defun PDISSAT_SAVE (/ SUS)
 (setq SUS_LIST (list "cmdecho" "orthomode" "osmode" "blipmode" "clayer" "angbase" "angdir" "cecolor"))
 (setq SUS (mapcar 'getvar SUS_LIST))
 (setq TERR$ *error*)
 (setq *error* PDISSAT_ETRAP)
 (PDISSAT_MF)
 (princ))
;
;//////////////////////////////////////////////////////////////////////////
;
; Main Function
;
(defun PDISSAT_MF ()
 (setq T1_list '("Type 1" "Type 2" "Type 3" "Type 4"))
 (setq S1_list '( "600mm" "525mm" "450mm" "375mm" "300mm" "225mm" "150mm"))
 (setq dcl_id (load_dialog "PDISSAT.dcl"))
 (if (not (new_dialog "PDISSAT" dcl_id))
   (progn (ALERT "Can not find your dcl file")
     (exit)))
 (start_list "T1")
 (mapcar 'add_list T1_list)
 (end_list)
 (start_list "S1")
 (mapcar 'add_list S1_list)
 (end_list)
 (if HOLE:DEF (set_tile "T1" (itoa HOLE:DEF)))
 (if SIZE:DEF (set_tile "S1" (itoa SIZE:DEF)))
 (action_tile "cancel" "(done_dialog)(setq userclick nil)")
 (action_tile "accept"
   (strcat
    "(progn
     (setq H:OLE (atoi (get_tile \"T1\")) HOLE:DEF H:OLE)"
    "(setq S:IZE (atoi (get_tile \"S1\")) SIZE:DEF S:IZE)"
    "(done_dialog)(setq userclick T))"))
 (start_dialog)
 (unload_dialog dcl_id)
 (if userclick
   (PDISSAT_VARIABLE))
 (princ))
;
;//////////////////////////////////////////////////////////////////////////
;
; PDISSAT_VARIABLE Function
;
(defun PDISSAT_VARIABLE ()
 (progn
   (setq HOLE$ (fix H:OLE))
   (setq HOLE$ (nth H:OLE T1_list))
   (cond
     ((= HOLE$ "Type 1"))
     ((= HOLE$ "Type 2"))
     ((= HOLE$ "Type 3"))
     ((= HOLE$ "Type 4"))))
 (setq HOLE HOLE$)
 (progn 
   (setq SIZE$ (fix S:IZE))
   (setq SIZE$ (nth S:IZE S1_list))
   (cond
     ((= SIZE$  "600mm")(setq SIZE$  "600"))
     ((= SIZE$  "525mm")(setq SIZE$  "525"))
     ((= SIZE$  "450mm")(setq SIZE$  "450"))
     ((= SIZE$  "375mm")(setq SIZE$  "375"))
     ((= SIZE$  "300mm")(setq SIZE$  "300"))
     ((= SIZE$  "225mm")(setq SIZE$  "225"))
     ((= SIZE$  "150mm")(setq SIZE$  "150"))))
 (setq SIZE SIZE$) 
 (PDISSAT_OUTPUT)
 (princ))
;
;//////////////////////////////////////////////////////////////////////////
;
; PDISSAT_OUTPUT Function
;
(defun PDISSAT_OUTPUT ()
 (if (null (tblsearch "STYLE" "CCC_Services"))
   (entmake
     (list
       (cons 0 "STYLE")
       (cons 100 "AcDbSymbolTableRecord")
       (cons 100 "AcDbTextStyleTableRecord")
       (cons 2 "CCC_Services")
       (cons 3 "Verdana.ttf")
       (cons 40 0)
       (cons 70 0))))
 (setq a  (strcat "CCC_DR_"SIZE"_"HOLE)
       b  (strcat "CCC_SERVICES_PROPOSED_Drainage_Storm_Sewer_Ductile_Iron_"SIZE"_"HOLE)
       lw 30)
 (if (null (tblsearch "LTYPE" a))
   (command "_.-linetype" "_l" a "CCC_Drainage.lin" ""))
 (if (null (tblsearch "LAYER" b))
   (entmake
     (list
       (cons 0 "LAYER")
       (cons 100 "AcDbSymbolTableRecord")
       (cons 100 "AcDbLayerTableRecord")
       (cons 2 b)
       (cons 6 a)
       (cons 62 30)
       (cons 70 0)
       (cons 370 lw))))
 (setvar "cmdecho" 0)
 (setvar "angbase" 0.0000)
 (setvar "angdir"  0)
 (setvar "orthomode" 0)
 (setvar "osmode"    16383)
 (setq PT01 (getpoint "\nEnter the line start point: "))
 (while
   (/= nil (setq PT02 (getpoint PT01 "\nEnter the line end point: ")))
   (setq RADIANS (angle PT01 PT02)
         DEGREES (PDISSAT_RTD RADIANS))
   (entmakex
     (list
       (cons 0 "LWPOLYLINE")
       (cons 100 "AcDbEntity")
       (cons 8 b)
       (cons 100 "AcDbPolyline")
       (cons 90 2)
       (cons 70 0)
       (cons 10 PT01)
       (cons 10 PT02)
       (cons 43 0.3)))
   (setq PT01 PT02))
 (PDISSAT_RESTORE)
 (princ))
;
;//////////////////////////////////////////////////////////////////////////
;
; Degrees to Radians Function
;
(defun PDISSAT_DTR (DEGREES)
(* pi (/ DEGREES 180.0)))
;
;//////////////////////////////////////////////////////////////////////////
;
; Radians to Degrees Function
;
(defun PDISSAT_RTD (RADIANS)
 (* 180.0 (/ RADIANS pi)))
;
;//////////////////////////////////////////////////////////////////////////
;
; Restore User Settings Function.
;
(defun PDISSAT_RESTORE ()
 (setq *error* TERR$)
 (if SUS (mapcar 'setvar SUS_LIST SUS))
 (princ "\nProgram completed and will now restore the user settings and exit.")
 (princ))
;
;/////////////////////////////////////////////////////////////////////////////
;
; Error Trap Function.
;
(defun PDISSAT_ETRAP (ERRORMSG)
 (command nil nil nil)
 (if (not (member ERRORMSG '("console break" "Function cancelled")))
   (princ (strcat "\nError:" ERRORMSG)))
 (if SUS (mapcar 'setvar SUS_LIST SUS))
 (princ "\nAn *error* has occured!")
 (princ "\nThe program will now restore the user settings and exit.")
 (terpri)
 (setq *error* TERR$)
 (princ))
;
;//////////////////////////////////////////////////////////////////////////

April 6, 2010

Buzzard,

I have tried to remove the rotation myself but I keep getting stuck with the layer not switching to the layer that is to be set.

I want to remove the rotation and enable linetype generation which will make it easier to see the types on the drawing.

Thanks.

PDISSAT.lsp

April 6, 2010

Buzzard,

I have tried to remove the rotation myself but I keep getting stuck with the layer not switching to the layer that is to be set.

I want to remove the rotation and enable linetype generation which will make it easier to see the types on the drawing.

Thanks.

woodman78,

I posted two codes, One with rotation and One without rotation. (See post 54) I also pointed out the problem with the layer not switching (See post 53) which was also taken care of in the above two codes in post 54. Have you read those two post at all?

One more thing, I am not sure what you mean by enabling linetype generation. Can you please explain? The above two programs are setting the correct layer which in turn has the correct linetype assigned. How much easier can it get?

April 6, 2010

I had read them Buzzard but maybe I haven't explained things very well. What I was looking to do by getting rid of the rotation was to go back to a single polyline, not segments, so I can activate Linetype Generation. I think this is a better way to deal with the short line lengths issue.

Thanks

April 6, 2010

I had read them Buzzard but maybe I haven't explained things very well. What I was looking to do by getting rid of the rotation was to go back to a single polyline, not segments, so I can activate Linetype Generation. I think this is a better way to deal with the short line lengths issue.

Thanks

Ok I understand now,

I will have something for you later, I am kind of busy at the moment, But it should not be much of a problem.

April 6, 2010

woodman78,

I am very sorry, But I am really busy for the moment. At this stage it is hard to tell when I will get some time to fix this for you. I would suggest you start another thread with the problem you wish to resolve. You may get alot of help that way since the title of this thread has nothing to do with the problem now in question.

Again I am very sorry, But I do not want to hold you up if this is a pressing issue.

DCL Radio Buttons

Recommended Posts

The Buzzard

Link to comment

Share on other sites

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Posted Images

The Buzzard

Link to comment

Share on other sites

The Buzzard

Link to comment

Share on other sites

The Buzzard

Link to comment

Share on other sites

The Buzzard

Link to comment

Share on other sites

woodman78

Link to comment

Share on other sites

The Buzzard

Link to comment

Share on other sites

woodman78

Link to comment

Share on other sites

The Buzzard

Link to comment

Share on other sites

The Buzzard

Link to comment

Share on other sites

The Buzzard

Link to comment

Share on other sites

woodman78

Link to comment

Share on other sites

The Buzzard

Link to comment

Share on other sites

The Buzzard

Link to comment

Share on other sites

woodman78

Link to comment

Share on other sites

The Buzzard

Link to comment

Share on other sites

woodman78

Link to comment

Share on other sites

The Buzzard

Link to comment

Share on other sites

The Buzzard

Link to comment

Share on other sites

Join the conversation

Tutorials

Forums

Activity