Question about linetypes / rotation within

Marcow,

 

I had to correct the line indicated in RED for the error trap. See below. I must have been in a hurry.

 

Sorry about that.

The Buzzard

;//////////////////////////////////////////////////////////////////////////
; Start-Up Function
(defun C:GL () ;Define function
(GL_MF) ;Go to GL_MF ~ Main Function
(princ) ;Exit quietly
) ;End defun
(princ "\nGL.lsp Loaded....") ;print message to command line
(princ "\nType GL to start program.") ;print message to command line
;;;//////////////////////////////////////////////////////////////////////////
; Main Function
(defun GL_MF (/ SUCE SUOM SUSM SUAB SUAD MIDPT PLEN PT01 PT02) ;Define function, Declare local variables
(setq SUCE (getvar "cmdecho")) ;Save User Command Echo
(setq SUOM (getvar "orthomode")) ;Save User Orthomode
(setq SUSM (getvar "osmode")) ;Save User Object Snapmode
(setq SUAB (getvar "angbase")) ;Save User Angle Base
(setq SUAD (getvar "angdir")) ;Save User Angle Direction
(setq SUCL (getvar "clayer")) ;Save User Current Layer
(setq temperr *error*) ;Save Temporary Error
[color=red](setq *error* GL_ET) ;Go to GL_ET ~ Error Trap Function[/color]
(GL_LC "GAS LINE" "3" "GAS_LINE" "") ;Go to GL_LC Layer Function, Layer Name, Color, Linetype & Lineweight
(setvar "cmdecho" 0) ;Set Command Echo to 0
(setvar "angbase" 0.0000) ;Set Angle Base to 0
(setvar "angdir" 0) ;Set Angle Direction to 0
(setvar "orthomode" 1) ;Turn on Orthomode
(setvar "osmode" SUSM) ;Turn on User Object Snaps
(setq PT01 (getpoint "\nEnter the line start point:")) ;Get the first point of line
(while ;Evaluate expression till nill
(/= nil ;If not =
(setq PT02 (getpoint PT01 "\nEnter the line end point:")) ;Set point 2
) ;End if not
(setvar "osmode" 0) ;Turn off all Object Snaps
(progn ;Then do the following
(command "._pline" PT01 PT02 "") ;Pline command
(setq RADIANS (angle PT01 PT02)) ;Get line angle in radians
(setq DEGREES (GL_RTD RADIANS)) ;Convert radians to degrees
(setq PLEN (distance PT01 PT02)) ;Get the line distance
(setq MIDPT (polar PT01 (GL_DTR DEGREES)(/ PLEN 2.0))) ;Set the midpoint of the line
(setq PT01 PT02) ;Set point 1 from point 2
(setvar "osmode" SUSM) ;Turn on User Object Snaps
(if ;If the following returns true
(and ;Return the logical AND of the supplied arguments 
(> DEGREES 90.0) ;Degrees is greater than 90
(<= DEGREES 270.0) ;And less than or equal to 270
) ;End and
(command "._rotate" "_last" "" MIDPT "180.0") ;Rotate the line on it mid-point 180 degrees
) ;End if
) ;Otherwise...
) ;End while
(setq *error* temperr) ;Restore error
(setvar "cmdecho" SUCE) ;Restore Saved User Command Echo
(setvar "orthomode" SUOM) ;Restore Saved User Orthomode
(setvar "osmode" SUSM) ;Restore Saved User Object Snapmode
(setvar "angbase" SUAB) ;Restore Saved User Angle Base
(setvar "angdir" SUAD) ;Restore Saved User Angle Direction
(setvar "clayer" SUCL) ;Restore Saved User Current Layer
(princ) ;Exit quietly
) ;End defun
;//////////////////////////////////////////////////////////////////////////
; Degrees to Radians Function
(defun GL_DTR (DEGREES) ;Define function, DEGREES is the argument
(* pi (/ DEGREES 180.0)) ;Calculate Degress to radians
) ;End defun
;//////////////////////////////////////////////////////////////////////////
; Radians to Degrees Function
(defun GL_RTD (RADIANS) ;Define function, RADIANS is the argument
(* 180.0 (/ RADIANS pi)) ;Calculate Radians to degress
) ;End defun
;//////////////////////////////////////////////////////////////////////////
; Layer Create Function
(defun GL_LC (NLAY LCLR LTYP LWGT / LAY FRZ) ;Define function, Declare local variables and arguments
(setq CLAY (getvar "clayer")) ;Get the current layer
(setq LAY (tblsearch "layer" NLAY)) ;Search drawing to find layer, Note: (NOT USED)
(if ;If the following returns true
(not LAY) ;Layer not in drawing
(command "._layer" "_m" NLAY "_c" LCLR "" "_lt" LTYP "" "_lw" LWGT "") ;Layer command
(progn ;Then do the following
(setq FRZ (cdr (assoc 70 LAY))) ;Variable FRZ is frozen layer
(if ;If the following returns true
(= FRZ 65) ;Layer frozen from last edit
(progn ;Then do the following
(command "._layer" "_t" NLAY "") ;Thaw layer
(command "._layer" "_s" NLAY "") ;Set layer
) ;Otherwise...
(command "._layer" "_s" NLAY "") ;Set layer
) ;End if
) ;Otherwise...
) ;End if
(princ) ;Exit quietly
) ;End defun
;//////////////////////////////////////////////////////////////////////////
; Error Trap Function
(defun GL_ET (errmsg) ;Define function, errmsg is the argument
(command nil nil nil) ;When escape selected
(if ;If the following returns true
(not ;Verify that an item evaluates to nil
(member errmsg '("console break" "Function Cancelled")) ;Search list for an occurence of an expression
) ;End not
(princ (strcat "\nError:" errmsg)) ;Print message to command line
) ;End if
(setvar "cmdecho" SUCE) ;Restore Saved User Command Echo
(setvar "orthomode" SUOM) ;Restore Saved User Orthomode
(setvar "osmode" SUSM) ;Restore Saved User Object Snapmode
(setvar "angbase" SUAB) ;Restore Saved User Angle Base
(setvar "angdir" SUAD) ;Restore Saved User Angle Direction
(setvar "clayer" SUCL) ;Restore Saved User Current Layer
(princ "\nError, Restoring Variables.") ;Print message to command line
(terpri) ;Terminate print
(setq *error* temperr) ;Restore error
(princ) ;Exit quietly
) ;End defun
;//////////////////////////////////////////////////////////////////////////

 

Also I fixed an Unknown command "GL" Press F1 for help error

 

There was an extra "" quote in this line.

 

; Layer Create Function
(defun GL_LC (NLAY LCLR LTYP LWGT / LAY FRZ) ;Define function, Declare local variables and arguments
(setq CLAY (getvar "clayer")) ;Get the current layer
(setq LAY (tblsearch "layer" NLAY)) ;Search drawing to find layer, Note: (NOT USED)
(if ;If the following returns true
(not LAY) ;Layer not in drawing
[color=red](command "._layer" "_m" NLAY "_c" LCLR "" "_lt" LTYP "" "_lw" LWGT "") ;Layer command[/color]
(progn ;Then do the following
(setq FRZ (cdr (assoc 70 LAY))) ;Variable FRZ is frozen layer
(if ;If the following returns true
(= FRZ 65) ;Layer frozen from last edit
(progn ;Then do the following
(command "._layer" "_t" NLAY "") ;Thaw layer
(command "._layer" "_s" NLAY "") ;Set layer
) ;Otherwise...
(command "._layer" "_s" NLAY "") ;Set layer
) ;End if
) ;Otherwise...
) ;End if
(princ) ;Exit quietly
) ;End defun

 

See the attached below for the complete program.

It doesn't seem to work in AutoCAD 2011... how come?

I mean, if I look at the code I see nothing that seems odd in 2011. Can you?

It doesn't seem to work in AutoCAD 2011... how come?

I mean, if I look at the code I see nothing that seems odd in 2011. Can you?

MarcoW,

I am not sure since I do not have 2011, But I did experience one a problem with another code that was used in 2010 ended up being a problem with a command function that was changed from the previous versions. It would seem likely Autodesk is not finished changing things around. This is one of the reasons why it is better to use entmake then command calls. Just a thought. You could check against each command call to make sure that the sub-commands are the same to play it safe.

MarcoW,

Give this lisp a try. There are no command calls except for loading the linetype definitions. I hope this works for you.

It should still function like the other version.

GL.lsp

;/////////////////////////////////////////////////////////////////////////////
;
; Start-Up Function.
;
(defun C:GL (/ CPS STRPT ENDPT RAD DEG LNAM LTNAM LCLR LTYP LWGT SUS SUS_LST TERR *error*)
 (GL_SUS)
 (princ))
(princ "\nGL.lsp loaded... Type GL to start.")
;
;/////////////////////////////////////////////////////////////////////////////
;
; Save User Settings Function.
;
(defun GL_SUS ()
 (setq SUS_LST (list "cmdecho" "orthomode" "osmode" "blipmode" "clayer" "angbase" "angdir"))
 (setq SUS (mapcar 'getvar SUS_LST))
 (setq TERR *error*)
 (setq *error* GL_ET)
 (GL_GL)
 (princ))
;
;/////////////////////////////////////////////////////////////////////////////
;
; Get Linetype Function.
;
(defun GL_GL ()
 (or L::UNIT (setq L::UNIT "I"))
 (or L::TNAM (setq L::TNAM "GAS_LINE"))
 (GL_CPS)
 (initget 8 "I U")
 (setq L::UNIT
   (cond
     ((getkword (strcat"\nSelect linetype standard; [<I>SO, <U>S] Default <"L::UNIT">: ")))
     (T L::UNIT)))
 (initget 8 "GAS_LINE")
 (setq L::TNAM
   (cond
     ((getkword (strcat"\nDefault linetype: <"L::TNAM">: ")))
     (T L::TNAM)))
 (setq LTNAM L::TNAM)
 (if (not (tblsearch "LTYPE" LTNAM))
   (cond
     ((= L::UNIT "I")(command "._-linetype" "_load" LTNAM "acadiso.lin" ""))
     ((= L::UNIT "U")(command "._-linetype" "_load" LTNAM "acad.lin" ""))))
 (GL_ML)
 (princ))
;
;/////////////////////////////////////////////////////////////////////////////
;
; Make Layer Function.
;
(defun GL_ML ()
 (setq LNAM LTNAM LCLR 2 LTYP LTNAM)
 (if (null (tblsearch "layer" LNAM))
   (entmakex
     (list
       (cons 0   "LAYER")
       (cons 100 "AcDbSymbolTableRecord")
       (cons 100 "AcDbLayerTableRecord")
       (cons 2    LNAM)
       (cons 6    LTYP)
       (cons 62   LCLR)
       (cons 70   0)
       (cons 290  1))))
 (GL_MP)
 (princ))
;
;/////////////////////////////////////////////////////////////////////////////
;
; Make Polyline Function.
;
(defun GL_MP ()
 (setq STRPT (getpoint "\nSpecify line starting point: "))
 (setvar "osmode" (nth 2 SUS))
 (while
   (/= nil (setq ENDPT (getpoint STRPT "\nSpecify line ending point: ")))
   (setq RAD (angle STRPT ENDPT)
         DEG (GL_RTD RAD))
   (if (and (> DEG 90)(<= DEG 270))
     (entmakex
       (list
         (cons 0 "LWPOLYLINE")
         (cons 100 "AcDbEntity")
         (cons 8 LNAM)
         (cons 100 "AcDbPolyline")
         (cons 90 2)
         (cons 70 0)
         (cons 10 ENDPT)
         (cons 10 STRPT))))
   (if (or (> DEG 270)(<= DEG 90))
     (entmakex
       (list
         (cons 0 "LWPOLYLINE")
         (cons 100 "AcDbEntity")
         (cons 8 LNAM)
         (cons 100 "AcDbPolyline")
         (cons 90 2)
         (cons 70 0)
         (cons 10 STRPT)
         (cons 10 ENDPT))))
   (setq STRPT ENDPT))
 (GL_RUS)
 (princ))
;
;/////////////////////////////////////////////////////////////////////////////
;
; Radians To Degrees Function.
;
(defun GL_RTD (RAD)(* 180.0 (/ RAD pi)))
;
;/////////////////////////////////////////////////////////////////////////////
;
; Change Program Settings.
;
(defun GL_CPS ()
 (setq CPS (list 0 0 1 0 0))
 (mapcar (function setvar)(list "cmdecho" "blipmode" "orthomode" "angbase" "angdir") CPS)
 (princ))
;
;/////////////////////////////////////////////////////////////////////////////
;
; Restore User Settings Function.
;
(defun GL_RUS ()
 (setq *error* TERR)
 (if SUS (mapcar 'setvar SUS_LST SUS))
 (princ "\nProgram completed and will now restore the user settings and exit.")
 (princ))
;
;/////////////////////////////////////////////////////////////////////////////
;
; Error Trap Function.
;
(defun GL_ET (EMSG)
 (command nil nil nil)
 (if (not (member EMSG '("console break" "Function cancelled")))
   (princ (strcat "\nError:" EMSG)))
 (if SUS (mapcar 'setvar SUS_LST SUS))
 (princ "\nAttention!....A user error has occurred.")
 (princ "\nThe program will now restore the user settings and exit.")
 (terpri)
 (setq *error* TERR)
 (princ))
;
;/////////////////////////////////////////////////////////////////////////////

This is only a half answer compared to the lisps above but is quick and dirty when you only have a couple of lines say upside down. in particualr arcs. Our surveyors make polylines but dont necessarily join them all together so 1/2 a long line is correct.

Anyway explode the plines make sure your first line is at the correct direction rotate 180 if required, then just Pedit and join the remainder it will use the first line direction for the rest. A single arc gets a bit more complicated add a dummy line at start pedit then trim the line back off normally works. It wont though make the lines always read from bottom & right.

Thank you all for the replies!

@ The Buzzerd:the new lisp works fine, great job. I will study it to improve my skills.

Before I had your lisp I changed some things: pline -> line / osnam 1 -> osnap 3 and last "last" "_L".

This worked also. But TBH I don't know wich of these changes was responsible for the correction.

Anyway, it's working now. Tnx again!

Thank you all for the replies!

 

@ The Buzzerd:the new lisp works fine, great job. I will study it to improve my skills.

Before I had your lisp I changed some things: pline -> line / osnam 1 -> osnap 3 and last "last" "_L".

This worked also. But TBH I don't know wich of these changes was responsible for the correction.

Anyway, it's working now. Tnx again!

Next time take it slow. Try one thing at a time. I would suggest the last code would be better in the long run. Much faster and less hassle.

Good Luck

Hi Buzzard,

Thanks for pointing me in the "entmakex" direction. The penny has dropped, a bit too late, but it did. I found this link where some easy examples are given.

I will have to do some practice on those examples.

Kind regards,

MarcoW.

Hi Buzzard,

 

Thanks for pointing me in the "entmakex" direction. The penny has dropped, a bit too late, but it did. I found this link where some easy examples are given.

 

I will have to do some practice on those examples.

 

Kind regards,

MarcoW.

Have a look at this thread:http://www.cadtutor.net/forum/showthread.php?44768-Entmake-Functions&highlight=entmake+functions