jpsheader.jpg (29354 bytes)

AutoLisp Home

Home

 

A

U

T

O

L

I

S

P

 

 

A

U

T

O

L

I

S

P

 

 

 

A

U

T

O

L

I

S

P

 

A

U

T

O

L

I

S

P

 

 

A

U

T

O

L

I

S

P

 

 

 

 

A

U

T

O

L

I

S

P

 

 

 

 

A

U

T

O

L

I

S

P

 

 

 

A

U

T

O

L

I

S

P

 

 

A

U

T

O

L

I

S

P

 

 

A

U

T

O

L

I

S

P

 

 

 

 

A

U

T

O

L

I

S

P

 

A

U

T

O

L

I

S

P

 

 

A

U

T

O

L

I

S

P

 

 

 

A

U

T

O

L

I

S

P

 

 

 

A

U

T

O

L

I

S

P

 

 

 

A

U

T

O

L

I

S

P

 

 

 

A

U

T

O

L

I

S

P

 

A

U

T

O

L

I

S

P

 

 

AutoLisp Example Programs

Most From Users Request


CopyC.lsp - Wendy Diffendall, the Senior CAD Drafter at Facilities Planners + Architects in Harrisburg, PA. wanted a program to do multiple Copies with preset defaults.

GetArea.lsp - Jamey Westmoreland,  a Civil Engineer E.I.T. for Toothman-Orton Engineering Co. in Boise ID wanted a program to label the accumulated area of selected polyline entities.

GetAcre.lsp - Bruce Stanton wanted a program to label each polyline entity with the area in square feet and acreage.

DLD.lsp -  An anonymous visitor wanted a program to draw a vertical line next to multiple lines of text during a Dim Leader command.  Sounds easy right?  Yeesh!

LTR.lsp -  Jamey Westmoreland,  a Civil Engineer E.I.T. for Toothman-Orton Engineering Co. in Boise ID wanted a program to select a Line entity, a Text entity, then rotate the text entity based on the angle of the line.

TXTCNT.lsp - An anonymous visitor wanted a program to count how many times each text entity appeared in a drawing and display the  results sorted in a dialog box.

TEXTIN.lsp - A program to read from a text file and write to an AutoCAD drawing.

TEXTOUT.lsp - A program to read from an AutoCAD drawing and write to a text file.


Support this Site!


CopyC.lsp

   Wendy Diffendall, the Senior CAD Drafter at Facilities Planners + Architects in Harrisburg, PA. wanted a program to make the Copy command continuous.  Ask for a distance, ask for an angle, set them as defaults,   then Copy Continuously.

[ The Copy, Array and Offset commands were not cutting it!]

;CopyC.lsp - Copy Continuous

(defun C:CC()

;turn off the system echo
(setvar "cmdecho" 0)

;set the exit note to be successful
(setq ernote "\n ...CC.lsp Complete!")

;get a selection set
(if(setq eset(ssget))
   (progn

     ;set the base point [bpt] to be the center of the screen
     ;and set some variables to nothing

     (setq bpt (getvar "viewctr") dis nil ang nil ans "" acuDis nil)

     ;if the get distance function returns something invalid... keep trying
     (while(not(setq dis(getdist (getvar "viewctr") "\n Distance: "))))

     ;if the get angle function returns something invalid... keep trying
     (while(not(setq ang(getangle (getvar "viewctr") "\n Angle: "))))

     ;set the accumulated distance variable to equal the distance variable
     (setq acuDis dis)

     ;while the user does not want to exit
     (while(/= ans "X")

       ;print the current angle and distance to the command line
       (princ (strcat "\n Angle = " (angtos ang) " Distance = " (rtos dis)))

       ;find out what the user wants to do....return all answers in uppercase
       (setq ans

        (strcase

         (getstring "\n eXit/Angle/Distance/Enter to Copy: X/A/D  <enter>: ")

        )

       )

       ;if the user presses enter then
       (if(= ans "")
         (progn

            ;copy the entities from the [bpt] to the accumlated distance away
           (command "copy" eset "" bpt (polar bpt ang acuDis))

           ;set the accumulated distance to be farther from base point
           ;in other words...if dis = 24" then the 1st copy should be 24" from
           ;the original....the second copy should be 48" from the original
           ;the [acuDis] variable holds this distance. It gets [dis] added to
           ;it each loop.

           (setq acuDis(+ acuDis dis))

         )
       )

       ;if the user presses X to exit or types the word EXIT then set the
       ;[ans] variable to equal "X". The program will exit.
       (if(= ans "EXIT")(setq ans "X"))

       ;if the user wants to change the angle. [ang]
       (if(or(= ans "ANGLE")(= ans "A"))
         (while(not(setq ang(getangle (getvar "viewctr") "\n Angle: "))))
       )

       ;if the user wants to change the distance [dis]
       ;don't forget to reset the accumulated distance [acuDis]

       (if(or(= ans "DISTANCE")(= ans "D"))
         (progn
           (while(not(setq dis(getdist (getvar "viewctr") "\n Distance: "))))
           (setq acuDis dis)
         )
       )
     )
   )

   ;set the exit message to be unsuccessful if nothing was selected
   (setq ernote "\n Error - Nothing Selected. ")
)

;reset the system echo
(setvar "cmdecho" 1)

;print the exit message to the command line
(princ ernote)

;suppress the final echo
(princ)


)

;end of program

Download this file:  Click Here!


GetArea.lsp

Jamey Westmoreland,  a Civil Engineer E.I.T. for Toothman-Orton Engineering Co. in Boise ID wanted a program to label the accumulated area of selected polyline entities.

;GetArea.lsp - Total the areas of selected polyline entities.
;Warning....This will also return an area for an entity that is not enclosed.

(defun C:GetArea()

  ;turn off the system echo
  (setvar "cmdecho" 0)

  ;set up a variable to hold the accumulated areas
  (setq myArea 0)

  ;while the user keeps making a selection
  (while(setq ent(entsel))

    ;if an entity was selected and not a point in space
    (if(car ent)
      (progn

        ;let AutoCAD get the area of the object...cheap yet effective way out.
        ;Note: AutoCAD stores the area in the system variable "Area"

        (command "area" "Object" (car ent))

        ;print the area to the command line
        (princ

          (strcat "\n Total Area for this Object = " (rtos (getvar "Area")))

        )

        ;accumulate the area if it exist
        (if (getvar "Area")(setq myArea(+ myArea (getvar "Area"))))
      )
    )
  )

  ;ask for a text insertion point
  (setq pt1(getpoint "\n Insertion Point: "))

  ;print the area in the drawing
  (command "text" pt1 "" "" (strcat "Total Area: " (rtos myArea)))

  ;print the exit message to the command line
  (princ "\n ...GetArea.lsp Complete. \n ")

  ;suppress the last echo
  (princ)

)

;end of program

Download this file:  Click Here!


GetAcre.lsp

  Bruce Stanton wanted a program similar to the one above.  Except, he wanted to label each polyline entity with the area in square feet and acreage.

;GetAcre.lsp - Get the area of a selected polyline entity.
;Warning....This will also return an area for an entity that is not enclosed.


(defun C:GA()

  ;turn the system echo off
  (setvar "cmdecho" 0)

  ;set up the exit message
  (setq ernote "\n ...GA.lsp Complete. ")

  ;set up a variable to hold the area
  (setq myArea 0)

  ;select one object
  (setq ent(entsel))

  ;if an object was selected and not some point in space
  (if (car ent)
    (progn

     ;get AutoCAD to find the area of the polyline, cheap yet effective way out
     ;Note: AutoCAD stores the information in the system variable "Area"

     (command "area" "Object" (car ent))

     ;get the area from the system variable "Area" and convert from
     ;square inches to square feet

     (setq myarea (/(getvar "Area")144.0))

     ;print the sq feet to the command line
     (princ "\n Total Square Feet : ")(princ (rtos myArea))

     ;print the acreage to the command line after converting
     (princ "\n Total Acreage : ")(princ (rtos (/ myArea 43560.0)))

     ;ask the user for an insertion point for the text
     ;if the user presses enter then by pass the insertion procedure

     (if(setq pt1(getpoint "\n Insertion Point: "))
      (progn

        ;print the sq feet on the drawing
        (command "text" pt1 "" ""

            (strcat "Total Square Feet : " (rtos myArea))

        )

        ;move the text starting point and print the acreage on the drawing
        (command "text"
           (polar pt1 (* pi 1.5) (* 1.5 (getvar "textsize")))
           "" "" (strcat "Total Acreage : " (rtos (/ myArea 43560.0)))
        )

      )  ;close the if progn for point selection

     )    ;close the if

    )      ;close the if progn for object selection

    ;if nothing was selected then change the exit note to be unsuccessful
    (setq ernote "\n Error - Nothing Selected.")

  )        ;close the if statement

  ;print the exit note to the command line
  (princ ernote)

  ;reset the system echo variable
  (setvar "cmdecho" 1)

  ;suppress the last echo
  (princ)

)

; End of program

Download this file:  Click Here!


DLD.lsp

  Visitor wanted a program that would draw a vertical line next to multiple lines of text during a Dim Leader command.  Sounds simple right?   Yeesh!

;DLD.lsp - Draw a vertical line next to multiple lines of
;          text during a dim leader command.

(defun C:DLD()

;turn system echo off
(setvar "cmdecho" 0)

;get the start point of the leader line
(setq pt1(getpoint "\n Start Point: "))

;setup some variables to be used later
;[tp1] is a temporary point
;[cntr] is a counter
;[tht] holds the current text size

(setq tpt pt1 cntr 0 tht (getvar "textsize"))

;unremark the next line and replace YOUR_LAYER_NAME with your layer name,
;this would be the layer name for your leader lines and arrow head.
;If you are using a version of autocad above 14 you might have to replace
;"layer" with "-layer" or perhaps "_layer". You could write a function
;to check the version of autocad and decide which to use at that point.

;(command "layer" "set" "YOUR_LAYER_NAME" "")

;loop until the user quits selecting points
(while (/= nil(setq tpt(getpoint tpt "\n Next Point: ")))

   ;if it is the first point the user has selected
   (if(= cntr 0)

     ;start the leader command to get an arrow head and the first line
     ;then use the (command) function to exit the leader command

     (command "dim1" "lea" pt1 tpt (command))

     ;else just draw lines
     (command "line" oldpt tpt "")
   )

   ;increment the counter
   (setq cntr(+ cntr 1))

   ;get the angle of the last line drawn
   (setq angl(angle oldpt tpt))

   ;save the last point drawn
   (setq oldpt tpt)

)

;find the location for the text using the
;text size times 0.25

(setq txpt(polar oldpt angl (* tht 0.25)))

;loop while the user types in something besides <enter>
;the T allows spaces in the text string

(while(/= "" (setq str(getstring T "\n Text: ")))

   ;unremark the next line and replace YOUR_LAYER_NAME with your layer name.
   ;this would be the layer name for your text. If you are using a version
   ;of autocad above 14 you might have to replace "layer" with "-layer" or
   ;perhaps "_layer". You could write a function to check the version of
   ;autocad and decide which to use at that point.

   ;(command "layer" "set" "YOUR_LAYER_NAME" "")

   ;check the last line angle to decide whether the text
   ;should be Left or Right Justified.

   (if(or(< angl (/ pi 0.5))(> angl (* pi 1.5)))

     ;left justified
     (command "text" "j" "ML" txpt "" 0 str)

     ;right justified
     (command "text" "j" "MR" txpt "" 0 str)
   )

   ;unremark the next line and replace YOUR_LAYER_NAME with your layer name.
   ;this would be the layer name for the vertical line next to the text.
   ;If you are using a version of autocad above 14 you might have to replace
   ;"layer" with "-layer" or perhaps "_layer". You could write a function
   ;to check the version of autocad and decide which to use at that point.


   ;(command "layer" "set" "YOUR_LAYER_NAME" "")

   ;draw the vertical line
   (command "line"
     (polar oldpt (* pi 0.5) (/ tht 2.0))
     (polar oldpt (* pi 1.5) (+ (/ tht 2.0)(* tht 0.25)))
     ""
   )

   ;reset the text starting location down a line
   (setq txpt (polar txpt (* pi 1.5) (+ tht(* tht 0.25))))

   ;reset the location of the next vertical line
   (setq oldpt(polar oldpt (* pi 1.5) (+ tht(* tht 0.25))))
)

;reset the system echo
(setvar "cmdecho" 1)

;suppress the last echo
(princ)


)

;End of Program

Download this file:  Click Here!


LTR.lsp

  Jamey Westmoreland,  a Civil Engineer E.I.T. for Toothman-Orton Engineering Co. in Boise ID wanted a program to select a Line entity, a Text entity, then rotate the text entity based on the angle of the line.


;LTR.lsp - select a Line entity and a Text entity then rotate the text entity based on line angle.

(defun C:LTR()

;turn off the system echo
(setvar "cmdecho" 0)

;display a message on the command line
(princ "\n Select LINE with Correct Angle.")

;let the user select one entity
(if (setq eset(entsel))
   (progn

     ;get the entity name from the entsel command
     (setq en(car eset))

     ;get the DXF group codes of the selected entity
     (setq enlist(entget en))

     ;check to see if a LINE was selected
     (if(= "LINE" (cdr(assoc 0 enlist)))
       (progn

        ;display a message on the command line
        (princ "\n Select TEXT to Match Line Angle.")

        ;let the user select one entity
        (if(setq eset2(entsel))
          (progn

            ;get the starting point of the line
            (setq ept1(cdr(assoc 10 enlist)))
 
            ;get the end point of the line
            (setq ept2(cdr(assoc 11 enlist)))

            ;get the angle from the end points of the line
            (setq ang1(angle ept1 ept2))

            ;get the entity name from the entsel function
            (setq en2(car eset2))

            ;get the DXF Group Codes of the entity
            (setq enlist2(entget en2))

            ;change the angle in the text entities DXF group codes
            (setq enlist2(subst (cons 50 ang1)(assoc 50 enlist2)enlist2))

            ;update the text entity
            (entmod enlist2)
         )

         ;if the second entity wasn't selected...
         (princ "\n Select Text Entity Please. Program Aborted.")
       )
     )

     ;if the first entity wasn't a line
     (princ "\n Enitity selected was not a LINE. Program Aborted.")
    )
  )

  ;if the first entity wasn't selected
  (princ "\n Nothing selected. Program Aborted.")

)

;reset the system echo
(setvar "cmdecho" 1)

;suppress the last echo
(princ)

)

;End of Program



Download this file:  Click Here!


TXTCNT.lsp

  Visitor wanted a program to count how many times each text entity appeared in a drawing and display the  results sorted in a dialog box.


;TXTCNT.lsp - Count how many times each text entity appears.
; Display the results sorted in a dialog box.


(defun C:TXTCNT()

;define a sort routine - Usage: (srt list) - Let's not go into this yet! It works.
(defun srt(alist / n)(setq lcup nil rcup nil)
   (defun cts(a b)(cond((> a b)t)((= a b )t)(t nil)))
    (foreach n alist
     (while (and rcup(cts n(car rcup)))(setq lcup(cons(car rcup)lcup)rcup(cdr rcup)))
     (while (and lcup(cts(car lcup)n))(setq rcup(cons(car lcup)rcup)lcup(cdr lcup)))
     (setq rcup(cons n rcup))
    )
   (append(reverse lcup)rcup)
)

;turn the command echo off
(setvar "cmdecho" 0)

;setup a variable to hold the data
(setq datalist(list))

;select objects
(if (setq eset(ssget))
  (progn

    ;set a counter to the first item in the selection set
    (setq cntr 0)

    ;loop through each selected entity
    (while (< cntr (sslength eset))

      ;grab the entity's name
      (setq en(ssname eset cntr))

      ;grab the DXF group codes of the entity
      (setq enlist(entget en))
 

      ;ignore the entity if it is not a TEXT entity
      (if(= "TEXT" (cdr(assoc 0 enlist)))
       (progn
    

        ;get the text value from the DXF Group Code
        (setq str(cdr(assoc 1 enlist)))

        ;setup a variable to check if the entity exist in the datalist list
        (setq existing 0)
      

        ;loop through the datalist to find out if it is a new entity that needs
        ;to be added to the list or if it already exist and it's counter needs
        ;to be incremented
        (foreach a datalist
          (if (= (car a) str)(setq existing 1))
        )
     

        ;if the entity is new then
        (if (= existing 0)

         ;do this - Add the item to the datalist along with a counter that starts at 1
         (setq datalist(append datalist (list (cons str 1))))

         ;else it's cntr needs to be incremented
         (setq datalist
           (subst
             (cons str (+ 1 (cdr(assoc str datalist))))
             (assoc str datalist)
             datalist
           )
         )
       )
      )
     )
    ;increment the entity counter
    (setq cntr(+ cntr 1))
   )
  )
)

;setup a variable to hold the data again, this time in a different fashion
(setq newList(list))

;rearrange the list
(foreach a datalist
   (setq newList
     (append newList
       (list
         (strcat
          (substr
            (strcat (car a) " . . . . . . . . . . . . . . . . . . . . . . . . . . ")
            1 50
          )
          " - " (itoa(cdr a))
         )
       )
     )
   )
)

;sort the list
(setq newList(srt newList))

;put up the dialog box
(setq dcl_id (load_dialog "TXTCNT.dcl"))

;see if it is already loaded
(if (not (new_dialog "TXTCNT" dcl_id) ) (exit))

;add the data to the list in the dialog box
(start_list "datalist")
(mapcar ' add_list newList)
(end_list)

;if an action event occurs, do this function
(action_tile "cancel" "(setq ddiag 1)(done_dialog)")

;display the dialog box
(start_dialog)

;if the cancel button was pressed - display message
(if (= ddiag 1)
   (princ "\n \n ...TXTCNT Cancelled. \n ")
)

;unload the dialog box
(unload_dialog dcl_id)

;turn the command echo back on
(setvar "cmdecho" 1)

;supress the last echo
(princ)

)

;End of AutoLisp Program



DCL File:


TXTCNT : dialog {
label = "TXTCNT - Text Counter By: JefferyPSanders.com";
  : row {
   : list_box {
     key = "datalist";
     multiple_select = "FALSE";
     width = 60;
   }
  }
  : boxed_row {
    : button {
      key = "cancel";
      label = " Cancel ";
      is_default = false;
      is_cancel = true;
    }
  }
}

End of DCL File

 

Download this AutoLisp file:  Click Here!

Download this DCL file:  Click Here!

 


TextIn.lsp

Read Text From a File, Write Text in the AutoCAD Drawing

;TEXTIN.LSP By: Jeffery P. Sanders
;This program takes any text file and prints it in AutoCAD.

;define program - listing your variable names here
; resets them to nil after the program finishes

(defun C:TEXTIN(/ lts ernote inspt filen fil lineone)

  ;turn echo off

  (setvar "cmdecho" 0)

   ;get ltscale (Note: ltscale should always equal dimscale)
  (setq lts(getvar "ltscale"))

  ;set the exit note to display successful
  (setq ernote "\n....TextIn Complete.")

  ;get the text insertion point
  (setq inspt(getpoint "\nInsertion Point: "))

  ;use dialog box to get file name / the 4 allows
  ;the user to type in a new file extension
  ;the "txt" sets the default to be "*.txt"

  (setq filen
    (getfiled "Select Text File" "" "txt" 4)
  )

  ;if file exist, open file to read
  (if (setq fil(open filen "r"))

     ;progn necessary for multiple statements inside if statement
    (progn

     ;while the line from text file does not equal nil
    (while (setq lineone(read-line fil))

       ;print the text in AutoCAD drawing
      (command "text" inspt(* lts(getvar "textsize"))0.0 lineone)

       ;move down one line each loop by resetting the insertion point
      (setq inspt

          ;start the polar function i.e. [polar pt angle distance]
        (polar

           
;from the insertion point
           inspt

           
;set the angle to go down i.e. (270 deg OR pi + pi/2 radians)
          (* pi 1.5)

           
;distance down to the next line is (textsize x 1.5) x ltscale
           (* lts (* 1.5(getvar "textsize")))

         )
; close the polar function

       ) ; close the setq

     ) ; close the while loop

     ;close the text file
     (close fil)

   )
; close the if progn statement

   ;else set the exiting remark as an error
   (setq ernote (strcat "\nCannot Find File: " filen))

  )
; close the if statement

  ;turn echo on
  (setvar "cmdecho" 1)

  ;print the exiting remark
  (princ ernote)

  (princ "\n ")
   ; clear command line
  (princ)       
; no echo

)                  ; close the program


TextOut.lsp

Read Text From an AutoCAD Drawing, Write the Text To a File


;TEXTOUT.LSP By: Jeffery P. Sanders
;This program gets text from an AutoCAD drawing and writes it to a text file.

;define program - listing your variable names here
; resets them to nil after the program finishes
  
(defun C:TEXTOUT(/ lts ernote filen fil eset en enlist cntr)

  ;turn echo off
  (setvar "cmdecho" 0)

  ;get ltscale (Note: ltscale should always equal dimscale)
  (setq lts(getvar "ltscale"))

  ;set the exit note to successful
  (setq ernote "\n....TextOut Complete.")

  ;use dialog box to set file name / the 1 allows
  ;the user to type in a new file name
  ;the "txt" sets the default to be "*.txt"

  (setq filen
    (getfiled "Type or Select Text File Name" "" "txt" 1)
  )

  ;open file to write
  (if (setq fil(open filen "w"))

    ;progn necessary for multiple statements inside an if statement
    (progn

      ;if ssget returns a valid selection set
      (if (setq eset(ssget))

        ;progn necessary for multiple statements inside an if statement
        (progn

          ;set the entity counter to zero [the first entity in a set is zero]
          (setq cntr 0)

         
;step through each entity in the selection set
          (while (< cntr (sslength eset))

           
;get the entity name indexed by cntr
            (setq en(ssname eset cntr))

           
;get the DXF group codes for the entity
            (setq enlist(entget en))

           
;check the group code 0 to see if entity type = TEXT
            (if(= "TEXT" (cdr(assoc 0 enlist)))

             
;progn necessary for multiple statements inside an if statement
              (progn

               
;get the text string from the entity's DXF Group Code 1
                (setq str(cdr(assoc 1 enlist)))

                ;print the string to the command line
                (princ (strcat "\nOutput To File: " str))

                ;print the string to the file
                (princ (strcat "\n" str) fil)

              )
;close the if progn

            ) ;close the if statement

           
;increment the counter to get the next entity
            (setq cntr(+ cntr 1))

          )
;close the while loop

          ;close the text file
          (close fil)

        )
;close the if progn

        ;set the exit note as an error
        (setq ernote "\nError - No Entities Selected.")

      )
; close the if statement

    )
;close the if progn

    ;set the exit note to be an error
    (setq ernote (strcat "\nError - Could not create File: " filen))

  )
;close the if statement

  ;turn the command echo back on
  (setvar "cmdecho" 1)

  ;print the exit note to the command line
  (princ ernote)

  ;clear the command line
  (princ "\n ")

 
;supress last echo
  (princ)

)
;close the program


New!

Having trouble with one of the programs not working for your version of AutoCAD? 

Click this----->   Please fix this!


Support this Site!


AutoLisp Home

Home

All questions/complaints/suggestions should be sent to JefferyPSanders.com

Last Updated April 1st, 2013

Copyright 2002-2013 JefferyPSanders.com.  All rights reserved.