Axis Lisp and Utilities

Here is a lisp DCL program primarily to draw XY Axis or XYZ Axis. The user inputs values for min, max, tick length and tick increment. Circles instead of lines work well for the Z axis tick marks. In addition there are some simple routines for loading layers and textstyles. I put my fonttable program link here. The screen background can be changed to any gray value from white to black by inputting a value between 0-255. That gives us tools to make attractive graph presentations.

An Axis is a collection of lines. The easy way to draw lines in lisp is with the command function.

(defun demo1 ()
(setq pt1 (list 1 2 3)
pt2 (list 2 4 6))
(command “line” pt1 pt2 “”))

The line command is terminated with the empty quote. To add more line segments, add more points before the termination. This draws a triangle.

(defun demo2 ()
(setq pt1 (list 0 0 0)
pt2 (list 2 3 3)
pt3 (list 4 0 0))
(command “line” pt1 pt2 pt3 pt1 “”))

if the point are real numbers, not variables, the list can be quoted in-line. The line function also can use the “C” option to close the figure.

(defun demo3 ()
(command “line” ‘(0 0 0) ‘(2 3 3) ‘(4 0 0) “c” ))

a line subroutine can be used and re-used. this one is 2D. 3D can be implemented the same way.

(defun line1 (x1 y1 x2 y2)
(setq pt1 (list x1 y1 0)
pt2 (list x2 y2 0))
(command “line” pt1 pt2 “”))

(defun demo4 ()
(line1 0 0 2 3)
(line1 2 3 4 0)
(line1 4 0 0 0))

The visual lisp method to make a line is Addline. It works in either modelspace or populating a block (or paperspace). These spaces have to be set up as objects. Addline is a member of their class, so in VBA it becomes modelspace.Addline or blockdef.Addline. Once the necessary environment is made, the lines can be drawn as a block definition as easily as modelspace objects. Another advantage is that layer is just a property of the line. In more complex parametric drawing projects it is easier to specify the layer as a property of the line in the line creation subroutine than it is to change the current layer in the system before drawing the line. In this program the axis drawing is simple enough that it uses the current layer. The line subroutines below work as written for either modelspace or blockdefinition.

(defun demo5 ()
(vl-load-com)
(setq acadApp (vlax-get-acad-object))
(setq acadDoc (vla-get-ActiveDocument acadApp))
(setq ms (vla-get-ModelSpace acadDoc))

(line2 0 0 2 3 ms)
(line2 2 3 4 0 ms)
(line2 4 0 0 0 ms) )

(defun line2 (x1 y1 x2 y2 obj / pt1 pt2 lineobj)
(setq pt1 (vlax-3d-point x1 y1 0)
pt2 (vlax-3d-point x2 y2 0))
(setq lineObj (vla-AddLine obj pt1 pt2)) )

(defun demo6 ()
(vl-load-com)
(setq acadApp (vlax-get-acad-object))
(setq acadDoc (vla-get-ActiveDocument acadApp))
(setq ms (vla-get-ModelSpace acadDoc))

(line3 0 0 2 3 ms “Bold”)
(line3 2 3 4 0 ms “Center”)
(line3 4 0 0 0 ms “Hidden”) )

(defun line3 (x1 y1 x2 y2 obj lyr / pt1 pt2 lineobj)
(setq pt1 (vlax-3d-point x1 y1 0)
pt2 (vlax-3d-point x2 y2 0))
(setq lineobj (vla-AddLine obj pt1 pt2))
(vla-put-layer lineobj lyr) )

Here is the full Axis program with drawing utilities, sans the DCL file.


;; location of axis.lsp and dcl
 (setq axis_progdir "c:\\lisp\\axis\\")

(defun axis ()
   
   (load "c:\\LISP\\Table\\FontTable.LSP")
   (load "c:\\LISP\\Axis\\draw_axis.LSP")

 (setq dcl_id (load_dialog (strcat axis_progdir "axis.dcl")))
  (if (< dcl_id 0)
    (progn
      (alert "The Axis.DCL file could not be loaded.")
      (exit) ) )

  (if (not (new_dialog "axis" dcl_id))
    (progn
      (alert "DCL file loaded but not definition, internal problem with files" )
      (exit) )   )

  (set_axis_vars)

  (action_tile "resetform" "(set_axis_vars)")
  (action_tile "textstyles" "(loadstyles)")
  (action_tile "layers" "(loadlayers)")
  (action_tile "backcolor" "(backcolor)")

  (action_tile "xyaxis" "(savevars) (done_dialog 2)")
  (action_tile "xyzaxis" "(savevars) (done_dialog 3)")
  (action_tile "fonttable" "(done_dialog 4)")

  (action_tile "cancel" "(done_dialog 0)")

  (setq ddiag (start_dialog))

  (unload_dialog dcl_id)
   (if (= ddiag 2) (xy_axis) )
   (if (= ddiag 3) (xyz_axis) )
   (if (= ddiag 4) (fonttable) )
)


(defun set_axis_vars ()
    (set_tile "xmin" "-12")
    (set_tile "xmax" "12")
    (set_tile "xinc" "1")
    (set_tile "xtick" "0.5")

    (set_tile "ymin" "-12")
    (set_tile "ymax" "12")
    (set_tile "yinc" "1")
    (set_tile "ytick" "0.5")

    (set_tile "zmin" "-6")
    (set_tile "zmax" "6")
    (set_tile "zinc" "1")
    (set_tile "ztick" "0.25")
    
    (set_tile "blkname" "XY_Axis")
    (set_tile "bgcolor" "64")  )


(defun savevars()
  (setq xmin (atof (get_tile "xmin")))
  (setq xmax (atof (get_tile "xmax")))
  (setq xinc (atof (get_tile "xinc")))
  (setq xtick (atof (get_tile "xtick")))

  (setq ymin (atof (get_tile "ymin")))
  (setq ymax (atof (get_tile "ymax")))
  (setq yinc (atof (get_tile "yinc")))
  (setq ytick (atof (get_tile "ytick")))

  (setq zmin (atof (get_tile "zmin")))
  (setq zmax (atof (get_tile "zmax")))
  (setq zinc (atof (get_tile "zinc")))
  (setq ztick (atof (get_tile "ztick")))

  (setq blkname (get_tile "blkname")) )


  (defun xy_axis ( )
    (draw_xy_axis xmin xmax xinc xtick ymin ymax yinc ytick blkname))

  (defun xyz_axis ( )
    (draw_xyz_axis xmin xmax xinc xtick ymin ymax yinc ytick zmin zmax zinc ztick blkname))


 (defun loadstyles ( )
   (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")
   (setvar "textstyle" "Calibri")  )


 (defun loadlayers ( )
    (setq LT "continuous" LW 35)
    (makelayer "Axis" 1 LT LW)
    (makelayer "Directrix" 5 LT LW)
    (makelayer "Focus" 5 LT LW)
    (makelayer "Asymptote" 5 LT -3)
    (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)

    (setvar "clayer" "Axis")
    (setvar "LWDISPLAY" 1) )


 (defun backcolor ( )
	(setq rgbnum (atoi (get_tile "bgcolor")))
	(bkg rgbnum)  )


(defun setfonttable ( )
   (fonttable)  )


(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))) )


(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)))  )


;modelspace 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)  )

Draw_Axis.LSP is in a separate file. FontTable was posted previously. The Axis is created as a block. There is an editbox on the DCL form for the block name. When making blocks with Visual Lisp objects, if the block already exists, the new entities will simply be added to the definition. This is not what is intended, so a utility must be used to delete the old block definition. This is not possible if the block is inserted into the drawing, so another utility must be used to first delete instances, then the definition can be deleted. I found these routines on message boards. I wont post them since they are not mine. They are not long and work well. Be aware you need to devise your own solution or tolerance to this problem.


;draw_axis_lsp

(defun line (x1 y1 x2 y2 obj)
  (setq pt1 (vlax-3d-point x1 y1 0)
        pt2 (vlax-3d-point x2 y2 0))
  (setq lineObj (vla-AddLine obj pt1 pt2)) )


(defun linexyz (x1 y1 z1 x2 y2 z2 obj)
  (setq pt1 (vlax-3d-point x1 y1 z1)
        pt2 (vlax-3d-point x2 y2 z2))
  (setq lineObj (vla-AddLine obj pt1 pt2)) )


(defun draw_xtick (x ticklen obj)
  (setq pt1 (vlax-3d-point x (- (/ ticklen 2.0)) 0)
        pt2 (vlax-3d-point x (+ (/ ticklen 2.0)) 0))
   (setq lineObj (vla-AddLine obj pt1 pt2)) )

(defun draw_ytick (y ticklen obj)
  (setq pt1 (vlax-3d-point (- (/ ticklen 2.0)) y 0)
        pt2 (vlax-3d-point (+ (/ ticklen 2.0)) y 0))
   (setq lineObj (vla-AddLine obj pt1 pt2)) )

(defun circle (x1 y1 z1 rad obj / pt1 circleobj)
  (setq pt1 (vlax-3d-point x1 y1 z1))
   (setq circleobj (vla-AddCircle obj pt1 rad)) )

(defun draw_ztick (z ticklen obj)
  (setq pt1 (vlax-3d-point (- (/ ticklen 2.0)) 0 z)
        pt2 (vlax-3d-point (+ (/ ticklen 2.0)) 0 z))
   (setq lineObj (vla-AddLine obj pt1 pt2)) )


(defun x_axis (xmin xmax xinc ticklen obj)
(setq numpts (fix (1+ (/ (- xmax xmin) xinc))))
(line xmin 0 xmax 0 obj)
(setq inc 1)

(repeat numpts
 (setq x (+ xmin (* (- inc 1) xinc)))
 (setq inc (1+ inc))
 (draw_xtick x ticklen obj) )
 )


(defun y_axis (ymin ymax yinc ticklen obj)
(setq numpts (fix (1+ (/ (- ymax ymin) yinc))))
(line 0 ymin 0 ymax obj)
(setq inc 1)

(repeat numpts
 (setq y (+ ymin (* (- inc 1) yinc)))
 (setq inc (1+ inc))
 (draw_ytick y ticklen obj) )
 )


(defun z_axis (zmin zmax zinc ticklen obj)
(setq numpts (fix (1+ (/ (- zmax zmin) zinc))))
(linexyz 0 0 zmin  0 0 zmax obj)
(setq inc 1)

(repeat numpts
 (setq z (+ zmin (* (- inc 1) zinc)))
 (setq inc (1+ inc))
 (circle 0 0 z (/ ticklen 2) obj) )
 ;(ztick z ticklen obj) )
 )


(defun draw_xy_axis (xmin xmax xinc xtick ymin ymax yinc ytick blkname)
(vl-load-com)
   (setq acadApp (vlax-get-acad-object))
   (setq acadDoc (vla-get-ActiveDocument acadApp))
   (setq mSpace (vla-get-ModelSpace acadDoc))

    (del_blk blkname)
 
    (setq pt0 (vlax-3d-point 0 0 0))
  
    (setq blks (vla-get-Blocks acadDoc))
    (setq blkdef (vla-Add blks pt0 blkname))

    (x_axis xmin xmax xinc xtick blkdef)
    (y_axis ymin ymax yinc ytick blkdef)

   (setq blkref (vla-insertblock mspace pt0 blkname 1 1 1 0 ))
 )


(defun draw_xyz_axis (xmin xmax xinc xtick ymin ymax yinc ytick zmin zmax zinc ztick blkname)
(vl-load-com)
   (setq acadApp (vlax-get-acad-object))
   (setq acadDoc (vla-get-ActiveDocument acadApp))
   (setq mSpace (vla-get-ModelSpace acadDoc))

    (del_blk blkname)
 
    (setq pt0 (vlax-3d-point 0 0 0))
  
    (setq blks (vla-get-Blocks acadDoc))
    (setq blkdef (vla-Add blks pt0 blkname))

    (x_axis xmin xmax xinc xtick blkdef)
    (y_axis ymin ymax yinc ytick blkdef)
    (z_axis zmin zmax zinc ztick blkdef)

   (setq blkref (vla-insertblock mspace pt0 blkname 1 1 1 0 ))
 )

Advertisements