Extract text from drawing

;;By Dereje Kitaw
(defun C:trtr (/       eset
      MULTILEADER_ERM_L80n    MULTILEADER_ERM_L90n
      MULTILEADER_ERM_L140A
     ) ;define a program name
  (vl-load-com)
  (or station (setq station "F00"))
  (if (/= ""
 (setq
   strdia (getstring
    (strcat "\nEnter Station Code <" station "> ")
  )
 )
      )
    (setq station strdia)
  )

  (or file_name (setq file_name "mydata"))
  (if (/= ""
 (setq
   file_name_new
    (getstring
      (strcat "\nEnter File Name <" file_name "> ")
    )
 )
      )
    (setq file_name file_name_new)
  )

  (if (setq eset (ssget)) ;use the ssget function to select entities

    (progn ;use progn since there will be more than 1 statement

      (setq cntr 0) ;set the cntr to the first item in the set
      (setq MTexT_Set (ssadd))
      (setq MULTILEADER_Set (ssadd))
      (setq TEXT_Set (ssadd))


;;;      (setq wf (open "D:\mydata.txt" "w"))
      (setq file_1 "D:/")
      (setq wf (open (strcat file_1 file_name ".txt") "w"))

      (while (< cntr (sslength eset)) ;while cntr is less than the length of the set

;;;             Note: the length is one more than the index of items since the first item is zero.  In other words, to
;;;            get to the first item in a selection set consisting of one item you would use (ssname eset 0) not
;;;            (ssname eset 1).

(setq en (ssname eset cntr)) ;get the entity name of the item indexed with cntr

(setq enlist (entget en)) ;get the dxf group codes of the enitity

(setq entity_name (cdr (assoc 0 enlist))) ;get the layer name

;;; (princ "\n ") ;print "\n " will cause a new line to be printed

;;;        (princ entity_name)                            ;print the layer name to the command line
(cond
 ((= entity_name "MTEXT")
  (progn
    (setq
      content (cdr (assoc 1 (entget en)))
    )

    (setq val (strcat station "," content))
    (write-line val wf)
  )

 )

 ((= entity_name "MULTILEADER")
  (progn
    (setq
      content
(cdr (assoc 304 enlist))
    )
    (setq val (strcat station "," content))
    (write-line val wf)

  )
 )


 ((= entity_name "TEXT")
  (progn
(setq       content (cdr (assoc 1 (entget en))))

;;;     (setq
;;;       content
;;; (cdr (assoc 2 (entget (cdr (assoc 304 enlist)))))
;;;     )
    (setq val (strcat station "," content))
    (write-line val wf)

  )
 )



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

      ) ;close the while statement
      (close wf)
    ) ;close the progn on the if statement


    (princ "\n Error - No entities selected.")
;print a message on the else statement

; note: the if statement can be a " if then " statement or a " if then else" statement

  ) ;close the if statement











)

Align Text

(defun c:rrt (/
               ; local functions
               getSegment get-opp-ang undobegin undoend
               ; local variables
               ent txt_ent obj txt_obj obj_typ ang ans
               )

  ;;; FUNCTION
  ;;; rotates the user selected (M)TEXT to the user selected
  ;;; entity. valid entites are light weight plines, lines
  ;;; and (m)text. you are given the chance to rotate the
  ;;; by 180 degrees after intial rotation.
  ;;;
  ;;; ARGUMENTS
  ;;; none
  ;;;
  ;;; USAGE
  ;;; enter RRT on the comand line
  ;;;
  ;;; PLATFORMS
  ;;; 2000+
  ;;;
  ;;; AUTHOR
  ;;; Copyright© 2004 Mark S. Thomas
  ;;; mark_AT_theswamp.org
  ;;;
  ;;; VERSION
  ;;; 1.0 Tue Dec 07, 2004
  ;;; 1.1 Tue Dec 21, 2004 ; added ARC types
  ;;; 1.1a Tue Dec 21, 2004 ; reversed the pick order
  ;;;
  ;;; TODO:
  ;;; handle text that has 'fit' justification
  ;;; add more entites for angle extraction
  ;;; more testing

  (vl-load-com)

  ;; credit Stig Madsen
  ;; refer to thread titled "relaxed-curves" under the "Teach Me"
  ;; section of TheSwamp at www.theswamp.org/phpBB2/
  (defun getSegment (obj pt / cpt eParam stParam)
    (cond ((setq cpt (vlax-curve-getClosestPointTo obj pt))
           (setq eParam (fix (vlax-curve-getEndParam obj)))
           (if (= eParam (setq stParam (fix (vlax-curve-getParamAtPoint obj cpt))))
             (setq stParam (1- stParam))
             (setq eParam (1+ stParam))
             )
           (list eParam (vlax-curve-getPointAtParam obj stParam)
                 (vlax-curve-getPointAtParam obj eParam))
           )
          )
    )

  ;; undo functions
  (defun undobegin ()
    (vla-EndUndoMark
      (vlax-get-property
        (vlax-get-acad-object)
        'ActiveDocument
        )
      )
    (vla-StartUndoMark
      (vlax-get-property
        (vlax-get-acad-object)
        'ActiveDocument
        )
      )
    )

  (defun undoend ()
    (vla-EndUndoMark
      (vlax-get-property
        (vlax-get-acad-object)
        'ActiveDocument
        )
      )
    )

  ;; returns the oppsite of an angle define in radians
  (defun get-opp-ang (ang)
    (cond ((< ang pi)(+ ang pi))
          ((> ang pi)(- ang pi))
          ((equal ang pi) 0.0)
          ((equal ang 0.0) pi)
          )
    )

  ;; ================= body of main function starts here ======================
 
  ;;  -----------   Get the Text to Align  -----------------
  (cond
    ((setq txt_ent (car (entsel "\nSelect text to align")))
     (setq txt_obj (vlax-ename->vla-object txt_ent)
           obj_typ (vlax-get-property txt_obj 'ObjectName)
           )
     (cond
       ((or (= obj_typ "AcDbMText") (= obj_typ "AcDbText")))
       (T
         (setq txt_ent nil)
         (alert "I only know how to align (M)TEXT, sorry! "))
      )
    )
  )
 
  ;;  -----------   Get the Object to Align To  -----------------
  (cond
    ((and txt_ent
          (setq ent (entsel "\nSelect entity for alignment: ")))
       (setq obj (vlax-ename->vla-object (car ent))
             obj_typ (vlax-get-property obj 'ObjectName)
       )
       (cond
         ((= obj_typ "AcDbPolyline")
          (if (setq pt_lst (getSegment obj (last ent)))
            (setq ang (angle (cadr pt_lst)(caddr pt_lst)))
            )
          )
         ((= obj_typ "AcDbLine")
          (setq ang (vlax-get-property obj 'Angle))
          )
         ((= obj_typ "AcDbText")
          (setq ang (vlax-get-property obj 'Rotation))
          )
         ((= obj_typ "AcDbMText")
          (setq ang (vlax-get-property obj 'Rotation))
          )
         ((= obj_typ "AcDbArc")
          (setq ang (angle
                      (vlax-safearray->list
                        (vlax-variant-value
                          (vla-get-StartPoint obj)))
                      (vlax-safearray->list
                        (vlax-variant-value
                          (vla-get-EndPoint obj)))
                    )
           )
          )
       
         (T (alert "That's not an entity I deal with"))
       )
     )
  )
 
  ;;  -----------   Align the Text   -----------------
  (cond
    ((null ang)) ; do nothing
    ((null txt_ent)) ; do nothing
    (T
      (undobegin)
      (vlax-put-property txt_obj 'Rotation ang)
      (setq ans (getstring "\nRotate 180 [Y/N]<N>: "))
      (if (= (strcase ans) "Y")
        (vlax-put-property txt_obj 'Rotation (get-opp-ang ang))
        )
      (vlax-release-object txt_obj)
      (undoend)
     )
   )
  (princ)
)  Logged

Routine for rotating text to a the current viewtwist angle.

; ROTOTXT.LSP
; Routine for rotating text to a the current viewtwist angle.
;
;


(defun c:ROV ( / ss2 i vta tmp)
  (vl-load-com)
  (prompt "\n Select TEXT and MTEXT to rotate ")
  (setq ss2 (ssget '((0 . "*TEXT")))
        i   0
        vta (- 0 (getvar "viewtwist"))
  )
  (repeat (sslength ss2)
    (setq tmp (vlax-ename->vla-object (ssname ss2 i)))
    (if (eq (vla-get-ObjectName tmp) "AcDbText")
      (progn
        (vlax-put tmp "Rotation" vta)
        (vlax-put tmp "Alignment" acAlignmentLeft)
      )
      (progn
        (vlax-put tmp "Rotation" 0.0)
        (vlax-put tmp "AttachmentPoint" acAttachmentPointTopLeft)
      )
    )
    (setq i (1+ i))
  )
)

match only rotation of text lisp

(defun mangerr (msg)
  (if (null wasworld) (command "_.ucs" "_p"))
  (if msg (princ msg))
  (if olderr (setq *error* olderr))
  (princ)
)

(defun c:mang (/ olderr wasworld ent elist orient sset ssqty index ssqty next nxlst nxrot nwlst)
  (setq olderr *error* *error* mangerr)
  (command "_.undo" "_g")
  (if (= (getvar "worlducs") 1)(setq wasworld T))
  (if (null wasworld) (command ".ucs" "w"))
  (setq ent (entsel))
  (setq elist (entget (car ent)))
  (setq orient (assoc 50 elist))
  (prompt "\nSelect objects to match rotation:  ")
  (setq sset (ssget))
  (setq ssqty (sslength sset))
  (setq index 0)
  (repeat ssqty
     (setq next (ssname sset  index))
     (setq nxlst (entget next))
     (setq nxrot (assoc 50 nxlst))
     (setq nwlst (subst orient nxrot nxlst))
     (entmod nwlst)
     (setq index (1+ index))
  )
  (if (null wasworld)(command "_.ucs" "_p"))
  (setq *error* olderr)
  (command "_.undo" "_end")
  (princ)
)

Change the color of selected object- Lisp

(defun c:lcc ( / obj layer color)
 (while (setq obj (nentsel "\nSelect entity on layer: "))
 (setq layer (entget
 (tblobjname "layer" (cdr (assoc 8 (entget (car obj)))))
 )
 color (acad_colordlg (cdr (assoc 62 layer)))
 )
 (if color
 (entmod (subst (cons 62 color) (assoc 62 layer) layer))
 )
 )
 (princ)
 )

Change view to based on two points -Lisp

;;; This routine will dview twist a drawing by
;;; selecting points in the drawing.
;;; Also sets the snap angle for the new twist.

(defun C:DVT()
   (prompt "Select Points From Left To Right.")
   (setq point1 (getpoint "\nSelect First Reference Point:"))
   (setq point2 (getpoint "\nSelect Second Reference Point:"))
   (setq ang1 (angle point1 point2))(print ang1)
   (setq new_dv (angtos (- (* 2.00 pi) ang1) 0))
   (command "_dview" "" "tw" new_dv "")
;;; (setvar "snapang" (* -1.0 (getvar "viewtwist")))
   (princ)
)

reverse the direction in which Lines

;|

PLREV.LSP (c) 1999-2004 Tee Square Graphics

Version 2.03a - 11/15/2004

Used to reverse the direction in which Lines, Polylines, LWPolylines
  and other objects are drawn. Useful for correcting the "direction"
  of specialized complex linetypes.
____

Revision History:

Version 2.03a: problem with non-American English installations fixed
  (with thanks to Jürgen Palme); name changed from REV to PLREV to
  resolve conflict with shortcut for REVolve command. 11/15/2004

Version 2.03: problem with ByLayer linetype fixed. 9/18/2001

Version 2.02: revised to preserve layer property of selected object.
  8/17/2001

Version 2.01: error checking added; bug related to PLINEGEN system
  variable fixed. 3/27/2001

Version 2.0 updated to include Arcs and Circles. These will be
  converted to either Polylines or LWPolylines, depending on the
  current setting of the PLINETYPE variable. Circles and Arcs over
  180 may sometimes behave oddly; for best results, select these
  items by clicking on a point near the "quad" points, at 0, 90,
  180 or 270 degrees. If an Arc or Circle disappears during a REV
  operation, just enter a U (undo) command to bring back the object
  and try again by picking a different point on the object. 3/24/2001

Please report bugs and other difficulties, along with a detailed
  description of the steps leading up to the problem, via email to
  cadman@turvill.com.

|;

(defun C:PLREV (/ olderr cmde blip ltsc cclr snap pwid pgenen1 nam ent p obj ltp
                clr lts wid flgs first final next spl cur vert a clos zoomit clyr lyr)
  (setq olderr *error*)
  (defun *error* (x)
    (setvar "cmdecho" cmde)
    (setvar "blipmode" blip)
    (setvar "osmode" snap)
    (setvar "celtscale" ltsc)
    (setvar "cecolor" cclr)
    (setvar "plinewid" pwid)
    (setvar "plinegen" pgen)
    (setq *error* olderr)
    (princ)
  ) ;; end of *error* function
  (setq cmde (getvar "cmdecho")
        blip (getvar "blipmode")
        ltsc (getvar "celtscale")
        cclr (getvar "cecolor")
        snap (getvar "osmode")
        pwid (getvar "plinewid")
        clyr (getvar "clayer")
        pgen (getvar "plinegen"))
  (setvar "cmdecho" 0)
  (setvar "blipmode" 0)
  (setvar "osmode" 0)
  (setvar "plinewid" 0)
  (setvar "plinegen" 1)
  (command "_.undo" "_be")
  (while (null (setq en1 (entsel "\nPick an object to reverse: "))))
  (setq nam (car en1)
        ent (entget nam)
        p (cadr en1)
        obj (cdr (assoc 0 ent)))
  (cond
    ((= obj "CIRCLE")
      (setq ctr (cdr (assoc 10 ent))
            dia (* 2.0 (cdr (assoc 40 ent)))
            a (angle p ctr))
      (command "_.break" p (polar p (/ pi 4) 0.001)
               "_.pedit" p "_y" "_c" "_x")
      (carc))
    ((= obj "ARC")
      (command "_.break" p "@"
               "_.pedit" p "_y" "_j" nam (entlast) "" "_x")
      (carc))
    (T nil))
  (setq ltp (cdr (assoc 6 ent))
        lyr (cdr (assoc 8 ent))
        clr (cdr (assoc 62 ent))
        lts (cdr (assoc 48 ent))
        wid (cdr (assoc 40 ent))
        flgs (cdr (assoc 70 ent)))
  (if (not ltp)(setq ltp "bylayer"))
  (cond
    ((= obj "LINE")
      (setq first (assoc 10 ent)
            final (assoc 11 ent)
            ent (subst (cons 10 (cdr final)) first ent)
            ent (subst (cons 11 (cdr first)) final ent))
      (entmod ent))
    ((= obj "LWPOLYLINE")
      (setq final (cdr (assoc 10 (setq ent (reverse ent))))
            next (cdr (assoc 10 (cdr (member (assoc 10 ent) ent)))))
      (prev))
    ((= obj "POLYLINE")
      (setq spl (= (logand flgs 4) 4)
            cur (= (logand flgs 2) 2)
            vert (entnext nam))
      (if cur
        (command "_.pedit" p "_s" ""))
      (while (= (cdr (assoc 0 (entget (setq vert (entnext vert))))) "VERTEX")
        (setq next final
              final (cdr (assoc 10 (entget vert)))))
      (prev))
    (T (alert "Not a REVersible object.")))
  (command "_.undo" "_e")
  (setvar "cmdecho" cmde)
  (setvar "blipmode" blip)
  (setvar "osmode" snap)
  (setvar "celtscale" ltsc)
  (setvar "cecolor" cclr)
  (setvar "plinewid" pwid)
  (setvar "plinegen" pgen)
  (setvar "clayer" clyr)
  (setq *error* olderr)
  (princ)
)
(defun carc ()
  (setq ent (entget (entlast))
        nam (cdr (assoc -1 ent))
        obj (cdr (assoc 0 ent)))
)
(defun prev ()
  (setq a (angle next final)
        clos (= (logand flgs 1) 1))
  (if clos (command "_.pedit" nam "_o" ""))
  (setq zoomit (null (ssget "_c" final final)))
  (if zoomit (command "_.zoom" "_c" final ""))
  (if clr (command "_.color" clr))
  (if lts (setvar "celtscale" lts))
  (setvar "clayer" lyr)
  (command "_.pline" (polar final a 0.0001) final ""
           "_.chprop" (entlast) "" "_lt" ltp ""
           "_.pedit" (entlast) "_j" nam "" ""
           "_.break" final (polar final a 0.001))
  (if cur (command "_.pedit" (entlast) "_f" ""))
  (if spl (command "_.pedit" (entlast) "_s" ""))
  (if clos (command "_.pedit" (entlast) "_c" ""))
  (if wid (command "_.pedit" (entlast) "_w" wid ""))
  (if zoomit (command "_.zoom" "_p"))
)
(alert (strcat "PLREV.LSP (c) 1999-2004 Tee Square Graphics\n\n"
               "               Type PLREV to begin."))
(princ)