Lisp Setup

To make pretty math graphs with lineweights, colors, background and good looking fonts with math symbols, we will need some basic setup tools.

Everybody has a lisp setup. This is the easy way, using the command function from lisp, but a DCL dialog cannot call the command function. It exits with error “unhandled exception.” Twas ever thus and evermore shall be.

(defun setup ()
(setq LT "continuous" LW "0.35")

(makelayer "Axis" 1 LT LW)
(makelayer "Directrix" 5 LT LW)
(makelayer "Focus" 5 LT LW)
(makelayer "Asymptote" 5 LT "Default")
(makelayer "Graph" 7 LT LW)

(makelayer "1" 1 LT LW)
(makelayer "2" 2 LT LW)
(makelayer "3" 3 LT LW)
(makelayer "4" 4 LT LW)
(makelayer "5" 5 LT LW)
(makelayer "6" 6 LT LW)
(makelayer "7" 7 LT LW)
(makelayer "8" 8 LT LW)
(makelayer "9" 9 LT LW)

(command "layer" "s" "graph" "")
(command "units" "2" "4" "1" "2" "0" "N" )
(command "setvar" "LWDISPLAY" 1)

(maketextstyle "Arial" "Arial")
(maketextstyle "Arial Narrow" "Arial Narrow")
(maketextstyle "Calibri" "Calibri")
(maketextstyle "Calibri Light" "Calibri Light")
(maketextstyle "Courier New" "Courier New")

(maketextstyle "Table1" "Arial Narrow")
(c:romans)
)


(defun makelayer (name color linetype lineweight )
(command "layer" "m" name "c" color "" "L" linetype "" "LW" lineweight "" "") )

(defun maketextstyle (name fontname )
(command "style" name fontname "0" "1.0" "0" "No" "No" ))

(defun c:romans()
(command "style" "RomanS" "romans" "0" "0.75" "0" "No" "No" "No"))


; background shades of gray
(defun bkg (rgbnum)
(setq hexnum (rgbhex rgbnum))

(setq acadobject (vlax-get-acad-object))
(setq acadpref (vlax-get-property acadobject 'preferences))
(setq acaddisp (vlax-get-property acadpref 'display))
(vlax-put-property acaddisp 'GraphicsWinmodelBackgrndColor hexnum) )


  (defun RGBhex (RGBnum / r g b)
    (setq r (lsh RGBnum 16))
    (setq g (lsh RGBnum 8))
    (setq b RGBnum)
    (+ (+ r g) b)  )

to run code above from a DCL dialog we need to replace the command functions with entmake or visual lisp activeX methods.

for textstyle creation
http://adndevblog.typepad.com/autocad/2012/12/how-to-programmatically-create-a-new-text-style-with-truetype-fonts-in-lisp.html

autolisp layer entmake search yields many results.

for reference get the dxf codes returned for objects –

Command: (entget (tblobjname “layer” “0”))
((-1 . )
(0 . “LAYER”)
(5 . “10”)
(102 . “{ACAD_XDICTIONARY”)
(360 . )
(102 . “}”)
(330 . )
(100 . “AcDbSymbolTableRecord”)
(100 . “AcDbLayerTableRecord”)
(2 . “0”)
(70 . 0)
(62 . 7)
(6 . “Continuous”)
(290 . 1)
(370 . -3)
(390 . )
(347 . )
(348 . ))

Command: (entget (tblobjname “style” “arial”))
((-1 . )
(0 . “STYLE”)
(330 . )
(5 . “21B”)
(100 . “AcDbSymbolTableRecord”)
(100 . “AcDbTextStyleTableRecord”)
(2 . “Arial”)
(70 . 0)
(40 . 0.0)
(41 . 1.0)
(50 . 0.0)
(71 . 0)
(42 . 0.2)
(3 . “Arial”)
(4 . “”))

makelayer and maketextstyle are remade with the same argument list –

(DEFUN makelayer (name color Linetype Lineweight)
(entmake (list (cons 0 “LAYER”)
(cons 100 “AcDbSymbolTableRecord”)
(cons 100 “AcDbLayerTableRecord”)
(cons 2 name)
(cons 70 0)
(cons 62 color)
(cons 6 Linetype)
(cons 290 1)
(cons 370 Lineweight))))

(DEFUN maketextstyle (name fontname)
(entmake (list (cons 0 “STYLE”)
(cons 100 “AcDbSymbolTableRecord”)
(cons 100 “AcDbTextStyleTableRecord”)
(cons 2 name)
(cons 3 fontname)
(cons 70 0)
(cons 40 0.0)
(cons 41 1.0)
(cons 50 0.0)
(cons 71 0))))

autocad will let us know if DXF does not like the structure of the DXF code. We have to find the actual font name and suffix the extension.

(maketextstyle “Arial” “Arial.ttf”)
(maketextstyle “Arial Narrow” “ArialN.ttf”)
(maketextstyle “Calibri” “Calibri.ttf”)
(maketextstyle “Calibri Light” “CalibriL.ttf”)
(maketextstyle “Courier New” “Cour.ttf”)
(maketextstyle “Symbol” “Symbol.ttf”)

similarly the lineweight must be changed from 0.35 to 35, there may be other minor differences, such as the value for “Default” that has to be figured out. query the actual object in the drawing with the entget function above.

Fonts consist of 256 characters. a table 16 X 16 can display them all. Addtable works closely with the Tablestyle creation program. I have a statement to load Make_Ts at the head of the FontTable program. The tablestyle program uses the current textstyle and names itself the same way. to make a font table with a different font, i change the current textstyle, then re-run fonttable. This is a good reference for viewing the entire table for symbols and also i expect it to be handy for cut and paste to find greek symbols.

The original verson of the lisp tablestyle creation was taken from Lee Ambrosius’ blog
http://hyperpics.blogs.com/beyond_the_ui/2012/07/creating-a-table-style-with-autolisp-and-the-activex-api.html

(vl-load-com)

(defun c:Fonttable()
    
(load "c:\\LISP\\Table\\Make_TS.LSP")
(make_ts)

(setq numrows 17 numcolumns 16 rowheight 0.25 colwidth 0.375)

   (setq acadObj (vlax-get-acad-object))
   (setq doc (vla-get-ActiveDocument acadObj))

   (setq pt (vlax-3d-point 0 0 0))

   (setq modelSpace (vla-get-ModelSpace doc))
   (setq fTable (vla-Addtable modelSpace pt numrows numcolumns rowheight colwidth))
  
   (vla-settext fTable 0 0 (getvar "textstyle"))
    
   (vla-put-HeaderSuppressed ftable :vlax-true)

   (setq rownum 1 colnum 0 chrnum 0)

(repeat 16

  (repeat 16
      (vla-settext fTable rownum colnum (chr chrnum))
      (setq colnum (1+ colnum))
      (setq chrnum (1+ chrnum))) 

     (setq rownum (1+ rownum))
     (setq colnum 0)
  )
)


(defun Make_TS()
;original version from 
;;http://hyperpics.blogs.com/beyond_the_ui/2012/07/creating-a-table-style-with-autolisp-and-the-activex-api.html
; some of his code i changed i commented out as this file changes a lot depending on specific requirements
; and it is helpful to keep alternate methods and settings available.

;tablestyle uses and is named by current textstyle
(setq textstyle (getvar "textstyle"))

    ;; Get the AutoCAD application and current document
    (setq acadobj (vlax-get-acad-object))
    (setq doc (vla-get-ActiveDocument acadobj))

    ;; Get the Dictionaries collection and the TableStyle dictionary
    (setq dicts (vla-get-Dictionaries doc))
    (setq dictObj (vla-Item dicts "acad_tablestyle"))
    
    ;; Create a custom table style
    (setq key textstyle
          class "AcDbTableStyle")
    (setq custObj (vla-AddObject dictObj key class))

    ;; Set the name and description for the style
    (vla-put-Name custObj textstyle)
    (vla-put-Description custObj "Font named table style")

    ;; Sets the bit flag value for the style
    (vla-put-BitFlags custObj 1)

    ;; Sets the direction of the table, top to bottom or bottom to top
    (vla-put-FlowDirection custObj acTableTopToBottom)

    ;; Sets the supression of the table header
    ;; Does not seem to do anything in tablestyle
    ;; same statement using created table object must be in addtable
    (vla-put-HeaderSuppressed custObj :vlax-true)

    ;; Sets the horizontal margin for the table cells
    (vla-put-HorzCellMargin custObj 0.03)

    ;; Sets the supression of the table title
    (vla-put-TitleSuppressed custObj :vlax-false)

    ;; Sets the vertical margin for the table cells
    (vla-put-VertCellMargin custObj 0.03)

    ;; Set the alignment for the Data, Header, and Title rows
    ;; (vla-SetAlignment custObj (+ acDataRow acTitleRow) acMiddleLeft)
    (vla-SetAlignment custObj acDataRow acMiddlecenter)
    (vla-SetAlignment custObj acHeaderRow acMiddleCenter)
    (vla-SetAlignment custObj acTitleRow acMiddleCenter)

    ;; Set the background color for the Header and Title rows
    
    (setq colObj (vlax-create-object "AutoCAD.AcCmColor.21"))
    
    ;(vla-SetRGB colObj 98 136 213)
    ;(vla-SetBackgroundColor custObj (+ acHeaderRow acTitleRow) colObj)

    ;; Clear the background color for the Data rows
    (vla-SetBackgroundColorNone custObj acDataRow :vlax-true)

    ;; Set the bottom grid color for the Title row
    ;;63 is all gridlinetypes and 7 is all rowtypes
    (vla-SetRGB colObj 0 0 255)
    (vla-SetGridColor custObj 63 7 colObj)

;;     to set individual - bottom grid color for the Title row
;;    (vla-SetGridColor custObj acHorzBottom acTitleRow colObj)

   ;; Set the bottom grid lineweight for the Title row
    (vla-SetGridLineWeight custobj acHorzBottom acTitleRow acLnWt025)

    ;; Set the inside grid lines visible for the data and header rows
    (vla-SetGridVisibility custObj acHorzInside  (+ acDataRow acHeaderRow) :vlax-true)

    ;; Set the text height for the Title, Header and Data rows
    (vla-SetTextHeight custObj acTitleRow 0.25)
    (vla-SetTextHeight custObj acHeaderRow 0.125)
    (vla-SetTextHeight custObj acDataRow 0.125)

    ;; Set the text style
    ;;(vla-SetTextStyle custObj (+ acDataRow acHeaderRow acTitleRow) "Standard")
    (vla-SetTextStyle custObj (+ acDataRow acHeaderRow acTitleRow) (getvar "textstyle"))

    ;; Release the color object
    (vlax-release-object colObj)
   (setvar "ctablestyle" textstyle)

  (princ)
)