Author Topic: Examples of usage GRREAD - let's share  (Read 115825 times)

0 Members and 1 Guest are viewing this topic.

Lee Mac

  • Seagull
  • Posts: 12372
  • London, England
Re: Examples of usage GRREAD - let's share
« Reply #60 on: December 24, 2009, 10:32:20 AM »

alanjt

  • Needs a day job
  • Posts: 5328
  • Standby for witty remark...
Re: Examples of usage GRREAD - let's share
« Reply #61 on: December 24, 2009, 11:31:54 AM »
Here's a real simple one I did, modeled after a thread here. It's nice because it allows me to have the last typed in input available for the next time I create a text object. It's real simple.

Code: [Select]
;;; Quick Text
;;; Required Subroutines: AT:Mtext AT:Getstring
;;; Alan J. Thompson, 09.23.09
(defun c:QT (/ #Point1 #Point2 #String #Text #Final)
  (or QT:Default (setq QT:Default ""))
  (and (setq #String (AT:Getstring "Specify text string: " QT:Default))
       (not (eq #String ""))
       (setq QT:Default (strcase #String))
       (setq #Point1 (getpoint "\nSpecify placement point: "))
       (or (setq
             #Point2 (getpoint #Point1 "\nSpecify next point for angle <Zero>: ")
           ) ;_ setq
           (setq #Point2 #Point1)
       ) ;_ or
       (setq #Text (AT:Mtext #Point1 QT:Default 0 nil 5))
       (not (vla-put-rotation #Text (angle #Point1 #Point2)))
       (while (eq 5 (car (setq #Final (grread T 4 4))))
         (vla-put-insertionpoint #Text (vlax-3d-point (trans (cadr #Final) 1 0)))
       ) ;_ while
  ) ;_ and
  (princ)
) ;_ defun

You would need these two subroutines:
Code: [Select]
;;; Add MText to drawing
;;; #InsertionPoint - MText insertion point
;;; #String - String to place in created MText object
;;; #Width - Width of MText object (if nil, will be 0 width)
;;; #Layer - Layer to place Mtext object on (nil for current)
;;; #Justification - Justification # for Mtext object
;;;      1 or nil= TopLeft
;;;      2= TopCenter
;;;      3= TopRight
;;;      4= MiddleLeft
;;;      5= MiddleCenter
;;;      6= MiddleRight
;;;      7= BottomLeft
;;;      8= BottomCenter
;;;      9= BottomRight
;;; Alan J. Thompson, 05.23.09
(defun AT:MText (#InsertionPoint #String #Width #Layer #Justification / #Width
                 #Space #Insertion #Object
                )
  (or #Width (setq #Width 0))
  (or *AcadDoc*
      (setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object)))
  ) ;_ or
  (setq #Space     (if (or (eq acmodelspace
                               (vla-get-activespace *AcadDoc*)
                           ) ;_ eq
                           (eq :vlax-true (vla-get-mspace *AcadDoc*))
                       ) ;_ or
                     (vla-get-modelspace *AcadDoc*)
                     (vla-get-paperspace *AcadDoc*)
                   ) ;_ if
        #Insertion (cond
                     ((vl-consp #InsertionPoint) (vlax-3d-point #InsertionPoint))
                     ((eq (type #InsertionPoint) 'variant) #InsertionPoint)
                     (T nil)
                   ) ;_ cond
  ) ;_ setq
  ;; create MText object
  (setq #Object (vla-addmtext #Space #Insertion #Width #String))
  ;; change layer, if applicable
  (and #Layer
       (tblsearch "layer" #Layer)
       (vla-put-layer #Object #Layer)
  ) ;_ and
  ;; change justification & match insertion point with new justification
  (cond ((member #Justification (list 1 2 3 4 5 6 7 8 9))
         (vla-put-attachmentpoint #Object #Justification)
         (vla-move #Object
                   (vla-get-InsertionPoint #Object)
                   #Insertion
         ) ;_ vla-move
        )
  ) ;_ cond
  #Object
) ;_ defun

Code: [Select]
;;; Getstring Dialog Box
;;; #Title - Title of dialog box
;;; #Default - Default string within edit box
;;; Alan J. Thompson, 08.25.09
(defun AT:GetString
       (#Title #Default / #FileName #FileOpen #DclID #NewString)
  (setq #FileName (vl-filename-mktemp "" "" ".dcl")
        #FileOpen (open #FileName "W")
  ) ;_ setq
  (foreach x '("TempEditBox : dialog {" "key = \"Title\";"
               "label = \"\";" "initial_focus = \"Edit\";" "spacer;"
               ": row {" ": column {" "alignment = centered;"
               "fixed_width = true;" ": text {" "label = \"\";" "}" "}"
               ": edit_box {" "key = \"Edit\";" "allow_accept = true;"
               "edit_width = 40;" "fixed_width = true;" "}" "}"
               "spacer;" ": row {" "fixed_width = true;"
               "alignment = centered;" ": ok_button {" "width = 11;" "}"
               ": cancel_button {" "width = 11;" "}" "}" "}//"
              )
    (write-line x #FileOpen)
  ) ;_ foreach
  (close #FileOpen)
  (setq #DclID (load_dialog #FileName))
  (new_dialog "TempEditBox" #DclID)
  (set_tile "Title" #Title)
  (set_tile "Edit" #Default)
  (action_tile
    "accept"
    "(setq #NewString (get_tile \"Edit\"))(done_dialog)"
  ) ;_ action_tile
  (action_tile "cancel" "(done_dialog)")
  (start_dialog)
  (unload_dialog #DclID)
  (vl-file-delete #FileName)
  #NewString
) ;_ defun
« Last Edit: December 24, 2009, 12:25:02 PM by alanjt »
Civil 3D 2019 ~ Windohz 7 64bit
Dropbox

xianaihua

  • Newt
  • Posts: 40
Re: Examples of usage GRREAD - let's share
« Reply #62 on: December 24, 2009, 11:39:06 AM »
hi!alanjt
nice work!
Learn from you!

alanjt

  • Needs a day job
  • Posts: 5328
  • Standby for witty remark...
Re: Examples of usage GRREAD - let's share
« Reply #63 on: December 24, 2009, 11:56:53 AM »
hi!alanjt
nice work!
Learn from you!
Thanks :) but there are much much more qualified people here than me.
Civil 3D 2019 ~ Windohz 7 64bit
Dropbox

GDF

  • Water Moccasin
  • Posts: 2055
Re: Examples of usage GRREAD - let's share
« Reply #64 on: December 24, 2009, 12:20:42 PM »
hi!alanjt
nice work!
Learn from you!
Thanks :) but there are much much more qualified people here than me.

Very nice routine. I added this gem to my library. Thanks for sharing it.
Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2020x64 Windows 10x64

alanjt

  • Needs a day job
  • Posts: 5328
  • Standby for witty remark...
Re: Examples of usage GRREAD - let's share
« Reply #65 on: December 24, 2009, 12:23:15 PM »
Thanks and you're welcome. :)

hi!alanjt
nice work!
Learn from you!
Thanks :) but there are much much more qualified people here than me.

Very nice routine. I added this gem to my library. Thanks for sharing it.
Civil 3D 2019 ~ Windohz 7 64bit
Dropbox

alanjt

  • Needs a day job
  • Posts: 5328
  • Standby for witty remark...
Re: Examples of usage GRREAD - let's share
« Reply #66 on: December 24, 2009, 12:26:57 PM »
Copy the main routine again. I updated how the text is moved around with grread per something Lee had pointed out a while back (wrote it before that).

hi!alanjt
nice work!
Learn from you!
Thanks :) but there are much much more qualified people here than me.

Very nice routine. I added this gem to my library. Thanks for sharing it.
Civil 3D 2019 ~ Windohz 7 64bit
Dropbox

alanjt

  • Needs a day job
  • Posts: 5328
  • Standby for witty remark...
Re: Examples of usage GRREAD - let's share
« Reply #67 on: December 24, 2009, 12:30:58 PM »
Just playing around, learning how to use grread.

Code: [Select]
;;; Magic Eraser (erase anything cursor crosses)
;;; Alan J. Thompson, 10.15.09
(defun c:EE (/ #Read #Ent)
  (while (eq 5 (car (setq #Read (grread t 15 2))))
    (princ "\rMove cursor over object to erase: ")
    (if (setq #Ent (ssget (cadr #Read)))
      (vl-catch-all-apply 'entdel (list (ssname #Ent 0)))
    ) ;_ if
  ) ;_ while
  (princ)
) ;_ defun
Civil 3D 2019 ~ Windohz 7 64bit
Dropbox

alanjt

  • Needs a day job
  • Posts: 5328
  • Standby for witty remark...
Re: Examples of usage GRREAD - let's share
« Reply #68 on: December 24, 2009, 12:32:18 PM »
This has NO practical application, it was just more of my playing around with grread (learning).

Code: [Select]
;;; Dynamic Distance (distance displayed from picked base point)
;;; Alan J. Thompson, 11.09.09
(defun c:DyD (/ *error* #Pnt #Obj #Read #Dist)
  (setq *error* (lambda (x)
                  (and #Obj (vl-catch-all-apply 'vla-delete (list #Obj)))
                  (grtext)
                  (redraw)
                ) ;_ lambda
  ) ;_ setq
  (and (setq #Pnt (getpoint "\nSpecify base point: "))
       (setq #Obj (vlax-ename->vla-object
                    (entmakex (list '(0 . "CIRCLE")
                                    '(100 . "AcDbEntity")
                                    '(100 . "AcDbCircle")
                                    '(62 . 1)
                                    '(6 . "Continuous")
                                    '(40 . 1.0)
                                    (cons 10 (trans #Pnt 1 0))
                              ) ;_ list
                    ) ;_ entmakex
                  ) ;_ vlax-ename->vla-object
       ) ;_ setq
       (while (eq 5 (car (setq #Read (grread T 15 0))))
         (redraw)
         (grdraw #Pnt (cadr #Read) 1 1)
         (vl-catch-all-apply 'vla-put-radius (list #Obj (distance #Pnt (cadr #Read))))
         (setq #Dist (strcat "Distance: " (rtos (distance #Pnt (cadr #Read)))))
         (princ (strcat "\r" #Dist "          "))
         (grtext -1 #Dist)
       ) ;_ while
  ) ;_ and
  (*error* nil)
  (princ)
) ;_ defun
Civil 3D 2019 ~ Windohz 7 64bit
Dropbox

alanjt

  • Needs a day job
  • Posts: 5328
  • Standby for witty remark...
Re: Examples of usage GRREAD - let's share
« Reply #69 on: December 24, 2009, 12:34:43 PM »
Last one.

I did this one as a request (ended up not being what they wanted) and just got a little carried away.

Code: [Select]
;;; Place current drawing's directory contents (matching *.dwg) in MText
;;; Required Subroutines: AT:MText
;;; Alan J. Thompson, 10.28.09
(defun c:Dir2Text (/ AT:NumFix #Pnt1 #List #Pos #String #Text #Read)
  (defun AT:NumFix (#Num #Length / #Str)
    (setq #Str (vl-princ-to-string #Num))
    (while (and (<= (1+ (strlen #Str)) #Length) (< (strlen #Str) 16))
      (setq #Str (strcat "0" #Str))
    ) ;_ while
    #Str
  ) ;_ defun
  (cond
    ((setq #Pnt1 (getpoint "\nSpecify first corner: "))
     (setq #List   (vl-sort (vl-remove-if-not
                              '(lambda (x) (wcmatch x "*.dwg"))
                              (vl-directory-files (getvar 'dwgprefix))
                            ) ;_ vl-remove-if-not
                            '<
                   ) ;_ vl-sort
           #String ""
     ) ;_ setq
     (foreach x #List
       (setq #Pos (AT:NumFix (1+ (vl-position x #List)) (length #List)))
       (setq #String (strcat #String #Pos " - " (vl-filename-base x) "\\P"))
     ) ;_ foreach
     (setq #Text (AT:MText #Pnt1 #String 0 nil 1))
     (while (eq 5 (car (setq #Read (grread T 15 2))))
       (redraw)
       (grvecs (list 7
                     #Pnt1
                     (list (car (cadr #Read)) (cadr #Pnt1))
                     (list (car (cadr #Read)) (cadr #Pnt1))
                     (cadr #Read)
                     (cadr #Read)
                     (list (car #Pnt1) (cadr (cadr #Read)))
                     (list (car #Pnt1) (cadr (cadr #Read)))
                     #Pnt1
               ) ;_ list
       ) ;_ grvecs
       (vla-put-width #Text (abs (- (car #Pnt1) (car (cadr #Read)))))
     ) ;_ while
    )
  ) ;_ cond
  (redraw)
  (princ)
) ;_ defun

You'll need the AT:MText subroutine (posted above).
http://www.theswamp.org/index.php?topic=12813.msg369811#msg369811
Civil 3D 2019 ~ Windohz 7 64bit
Dropbox

xianaihua

  • Newt
  • Posts: 40
Re: Examples of usage GRREAD - let's share
« Reply #70 on: December 25, 2009, 12:02:03 AM »
Dear friends of the good works one after another eye-opener

Lee Mac

  • Seagull
  • Posts: 12372
  • London, England
Re: Examples of usage GRREAD - let's share
« Reply #71 on: December 26, 2009, 07:45:55 AM »
Alan, you could always cheat with your GetString  :evil:

Code: [Select]
(defun LM:GetString (#Default / dcTag result)
  (cond (  (<= (setq dcTag (load_dialog "ACAD")) 0))
        (  (not (new_dialog "acad_txtedit" dcTag)))
        (t
           (set_tile "text_edit" #Default)
           (action_tile "accept" "(setq result (get_tile \"text_edit\")) (done_dialog)")
           (action_tile "cancel" "(done_dialog)")

           (start_dialog)
           (unload_dialog dcTag)))
  result)

VovKa

  • Swamp Rat
  • Posts: 1223
  • Ukraine
Re: Examples of usage GRREAD - let's share
« Reply #72 on: December 26, 2009, 09:37:16 AM »
Lee, i'm a cheater too :)
Code: [Select]
(lisped "edit me")

alanjt

  • Needs a day job
  • Posts: 5328
  • Standby for witty remark...
Re: Examples of usage GRREAD - let's share
« Reply #73 on: December 26, 2009, 11:54:31 AM »
True, maybe one of these days I'll actually learn DCL properly.

Alan, you could always cheat with your GetString  :evil:

Code: [Select]
(defun LM:GetString (#Default / dcTag result)
  (cond (  (<= (setq dcTag (load_dialog "ACAD")) 0))
        (  (not (new_dialog "acad_txtedit" dcTag)))
        (t
           (set_tile "text_edit" #Default)
           (action_tile "accept" "(setq result (get_tile \"text_edit\")) (done_dialog)")
           (action_tile "cancel" "(done_dialog)")

           (start_dialog)
           (unload_dialog dcTag)))
  result)
Civil 3D 2019 ~ Windohz 7 64bit
Dropbox

Lee Mac

  • Seagull
  • Posts: 12372
  • London, England
Re: Examples of usage GRREAD - let's share
« Reply #74 on: December 26, 2009, 12:34:14 PM »
Nah, its just using whats already there  :evil: