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

0 Members and 1 Guest are viewing this topic.

alanjt

  • Needs a day job
  • Posts: 5328
  • Standby for witty remark...
Re: Examples of usage GRREAD - let's share
« Reply #75 on: December 26, 2009, 05:16:45 PM »
Nah, its just using whats already there  :evil:
Oh I know, I just meant that, if I knew enough about DCL, I would recognize what I needed.
Civil 3D 2019 ~ Windohz 7 64bit
Dropbox

CAB

  • Global Moderator
  • Seagull
  • Posts: 10386
Re: Examples of usage GRREAD - let's share
« Reply #76 on: December 26, 2009, 05:50:37 PM »
Alan, Just using ACAD dcl which is already built.
Code: [Select]
;;  Text Edit Only
;;  CAB  03.06.07
(defun c:teo (/ ss txt elst newtxt dcledit)
  (defun dcledit (txt / attlist NewTxt ddatt_dcl)
    (and
      (setq oldtxt txt
            dcl    (load_dialog "ACAD")
      )
      (new_dialog "acad_txtedit" dcl)
      (set_tile "text_edit" txt)
      (action_tile "text_edit" "(setq txt $value)")
      (action_tile "cancel" "(setq txt oldtxt)")
      (start_dialog)
      (unload_dialog dcl)
    )
    txt
  )
  (while (setq ss (ssget "_+.:E:S" '((0 . "TEXT"))))
    (setq elst (entget (ssname ss 0))
          txt  (cdr (assoc 1 elst))
    )
    (if (/= txt (setq NewTxt (dcledit txt)))
      (entupd
        (cdr (assoc -1 (entmod (subst (cons 1 NewTxt) (assoc 1 elst) elst))))
      )
    )
  )
  (princ)
)
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

Lee Mac

  • Seagull
  • Posts: 12372
  • London, England
Re: Examples of usage GRREAD - let's share
« Reply #77 on: December 26, 2009, 08:38:29 PM »
They are quite handy  :evil:

Code: [Select]
(defun c:qe (/ i ss tx ent)
  (and (setq i -1 ss (ssget "_:L" '((0 . "MTEXT,TEXT"))))
       (not (numberp (setq tx (lisped "New Text"))))
       (while (setq ent (ssname ss (setq i (1+ i))))
         (entmod (subst (cons 1 tx) (assoc 1 (entget ent)) (entget ent)))))
  (princ))

cmwade77

  • Swamp Rat
  • Posts: 1207
Re: Examples of usage GRREAD - let's share
« Reply #78 on: January 04, 2010, 07:17:59 PM »
Ok, anyone have a way to make polar snap work with GRRead? I have been trying, so far haven't even come close.

cmwade77

  • Swamp Rat
  • Posts: 1207
Re: Examples of usage GRREAD - let's share
« Reply #79 on: January 06, 2010, 03:11:15 PM »
Ok, I have another one here, this is a modification of Alan's code with VovKa's modification in it:
Code: [Select]
;*************************************************************************************************************************
;| VERSION HISTORY **
**
IB - VERSION 1.0 **
01/06/10 **
BY: CHRIS WADE **
**
- Insert Blocks on lines, arcs, polylines, other blocks, circles, etc. **
- Type: **
- W - Cycles from 3-5 wires **
- A - Changes to Arrowheads **
- C - Continuation Block **
- E - Use endpoint of object **
- T - Type block name. **
**
;*************************************************************************************************************************|;

; Code Adapted from VovKa's modification of Alanjt's code at http://www.theswamp.org/index.php?topic=12813.msg369625#msg369625
; Alanjt's Original code is located at: http://www.theswamp.org/index.php?topic=12813.msg369597#msg369597

(defun c:IB (/ #Ent #Read *error* blobj Ang lastpt cpt bname w ws bscale sObj oLay Snap Spt *thisdrawing* *modelspace* *paperspace*)
  ;;Error routine adapted from:
;;                     --=={  Dynamic Text Curve Align  }==--                    ;;
;;  AUTHOR:                                                                      ;;
;;                                                                               ;;
;;  Copyright © Lee McDonnell, November 2009. All Rights Reserved.               ;;
;;                                                                               ;;
;;      { Contact: Lee Mac @ TheSwamp.org, CADTutor.net }                        ;;
(defun *error* (msg)
(and blobj(or (and pLst (mapcar (function (lambda (x) (vlax-put blobj (car x) (cdr x)))) pLst)) (and (not (vlax-erased-p blobj)) (vla-delete blobj))))
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **")))
        (redraw)
(princ)
)
  (setq TMP nil)
  (vl-load-com)
  (setq bname "3W")
  (setq W 3)
  (setq bscale (/ (getvar "dimscale") 96)) 
  (vl-cmdf "._insert" bname)(command)
  (setq *thisdrawing* (vla-get-activedocument
(vlax-get-acad-object)
      ) ;_ end of vla-get-activedocument
      *modelspace*  (vla-get-ModelSpace *thisdrawing*)
  *paperspace*  (vla-get-PaperSpace *thisdrawing*))
  (and
    (setq #Ent (nentselp "\nSelect Item to Insert Block On: "))
    (vl-position (cdr (assoc 0 (entget (car #Ent))))
'("LWPOLYLINE" "ARC" "LINE" "CIRCLE" "ELLIPSE")
    )
    (setq #Read (caddr #Ent)
  #Ent (entmakex (append (entget (car #Ent)) (list (cons 60 1))))
    )
(setq Sobj (vlax-ename->vla-object #Ent)
  oLay (vla-get-Layer Sobj))
    (or (not #Read)
(not (vla-transformby Sobj (vlax-tmatrix #Read)))
    )
    (not
      (while (not (eq 25 (car (setq #Read (grread T 15 0)))))
  (princ "\rSpecify point for block ([W]ires/[A]rrow/[C]ontinuation block/[T]ype block name/[E]ndpoint): ")
  (redraw)
(cond
((eq 3 (car #Read))
(if (or (/= (getvar "cvport") 1) (/= (getvar "tilemode") 0))
(setq blobj (vla-InsertBlock *modelspace* (vlax-3d-point Spt) bname bscale bscale bscale Ang))
(setq blobj (vla-InsertBlock *paperspace* (vlax-3d-point Spt) bname bscale bscale bscale Ang))
)
(vla-put-Layer blobj oLay)
)
((and (= (car #Read) 2) (or (= (cadr #Read) 101) (= (cadr #Read) 69)))
(if (/= Snap "_End")
(setq Snap "_End")
(setq Snap nil)
)
)
((and (= (car #Read) 2) (or (= (cadr #Read) 119) (= (cadr #Read) 87)))
(if (< W 5)
(setq W (+ W 1))
(setq W 3)
)
(setq WS (rtos W 2 0))
(setq bname (strcat WS "W"))
(vl-cmdf "._insert" bname)(command)
(setq Snap nil)
)
((and (= (car #Read) 2) (or (= (cadr #Read) 65) (= (cadr #Read) 97)))
(cond
((= bname "hr")
(setq bname "hr2-11")
(setq Snap "_End")
)
(T
(setq bname "hr")
(setq Snap nil)
)
)
(vl-cmdf "._insert" bname)(command)
)
((and (= (car #Read) 2) (or (= (cadr #Read) 99) (= (cadr #Read) 67)))
(setq bname "cb")
(vl-cmdf "._insert" bname)(command)
(setq Snap "_End")
)
((and (= (car #Read) 2) (or (= (cadr #Read) 116) (= (cadr #Read) 84)))
(setq bname nil)
(while (or (= bname nil) (= bname ""))
(setq bname (getstring T "\nEnter Block Name: "))
)
(vl-cmdf "._insert" bname)(command)
(setq Snap nil)
)
(T
(if (vl-consp (cadr #Read))
(progn
(if (= lastpt nil)
(setq lastpt (vlax-curve-getclosestpointto #Ent (trans (cadr #Read) 1 0) T))
(progn
(setq cpt (vlax-curve-getclosestpointto #Ent (trans (cadr #Read) 1 0) T))
(setq data (trans (cadr #Read) 1 0))               
(setq Ang (+ (angle data cpt) (D2R 90)))
(if (/= snap nil)
(setq Spt (osnap cpt Snap))
(setq Spt cpt)
)
(if (/= Spt nil)
(progn
(if (/= blobj nil)
(if (not (vlax-erased-p blobj)) (vla-delete blobj))
)
(if (or (/= (getvar "cvport") 1) (/= (getvar "tilemode") 0))
(setq blobj (vla-InsertBlock *modelspace* (vlax-3d-point Spt) bname bscale bscale bscale Ang))
(setq blobj (vla-InsertBlock *paperspace* (vlax-3d-point Spt) bname bscale bscale bscale Ang))
)
)
)
(vla-put-Layer blobj oLay)

)
)

)  
)
)
)
      )
    )
    (entdel #Ent)
  )
  (redraw)
  (princ)
)

; Convert value in radians to degrees
(defun R2D (nbrOfRadians)
 (* 180.0 (/ nbrOfRadians pi))
)
; Convert value in degrees to radians
(defun D2R (numberOfDegrees)
 (* pi (/ numberOfDegrees 180.0))
) ;_ end of defun
(defun c:ktst ()
(while
(setq input (grread t 4 4))
(princ "\n")
(princ (cadr input))
)
)
The only problem that I am having is that if the object that you are inserting on is not closed, and you move the cursor off of the object, the block can get inserted in space (this seems to happen with the perpendicular line in the original code as well), any ideas on how to fix this?

alanjt

  • Needs a day job
  • Posts: 5328
  • Standby for witty remark...
Re: Examples of usage GRREAD - let's share
« Reply #80 on: January 06, 2010, 04:54:28 PM »
Off the top of my head, I think you just remove the last T call from these lines:

Code: [Select]
(vlax-curve-getclosestpointto #Ent (trans (cadr #Read) 1 0) [color=red]T[/color])Just take it out or set it to nil.
Civil 3D 2019 ~ Windohz 7 64bit
Dropbox

cmwade77

  • Swamp Rat
  • Posts: 1207
Re: Examples of usage GRREAD - let's share
« Reply #81 on: January 06, 2010, 05:41:46 PM »
Thank you very much Alan, that did the trick.

alanjt

  • Needs a day job
  • Posts: 5328
  • Standby for witty remark...
Re: Examples of usage GRREAD - let's share
« Reply #82 on: January 06, 2010, 05:58:11 PM »
Thank you very much Alan, that did the trick.
:)
Civil 3D 2019 ~ Windohz 7 64bit
Dropbox

chlh_jd

  • Guest
Re: Examples of usage GRREAD - let's share
« Reply #83 on: February 03, 2011, 12:47:15 AM »
Here's my rough code for use grread fun
Code: [Select]
;;;ss-grread
;;;
;;;get grread point , if type the keys then run Correlation function
;;;funkeys - Keywords from the keyboard
;;;fun_names - Function name or function name list
;;;funarg_list - The parameters list or parameters list tables used for the function
;;;
;;;Return the point list , Function during the implementation of fun1 arg1
;;;
;;;GSLS(ss) , 2010-07-21
(defun ss-grread (fun_keys fun_names funarg_list fun1 arg1 / is_go_on PT midkey pos funname funarglst)
  (setq is_go_on T)
  (while (and (setq PT (grread t 4 2))
     (/= 3 (car PT))
     (/= 25 (car pt))
     is_go_on
)
    (cond      
      ((and (= 2 (car pt)) (or (eq (strcase (chr (cadr pt))) fun_keys)  (eq (strcase (chr (cadr pt)) T) fun_keys)))
       (wjm-fun fun_names funarg_list)      
       (setq is_go_on nil)      
       )
      ((and (= 2 (car pt)) (or (setq midkey (member (strcase (chr (cadr pt))) fun_keys)) (setq midkey (member (strcase (chr (cadr pt)) T) fun_keys))))
       (setq pos (vl-position (car midkey) fun_keys)
    funname (nth pos fun_names)
    funarglst(nth pos funarg_list))
       (wjm-fun funname funarglst)      
       (setq is_go_on nil)      
       )
      (t      
(if (and (= 5 (car PT)) (null fun_keys))
  (progn
    (wjm-fun fun1 arg1)    
    )
)
       )
      )
    )
  (cadr PT)
  )
Used fun
Code: [Select]
;;;the follow function coded by WJM
(defun wjm-fun (funname funarglist)
  (if (progn (setq catchit (vl-catch-all-apply
     funname
     funarglist
   )
     )
     (vl-catch-all-error-p catchit)
      )
    (progn
      (princ "函数:")
      (princ funname)
      (princ "参数表:")
      (princ funarglist)
      (princ "\n捕捉到错误:")
      (princ (vl-catch-all-error-message catchit))
    )
  )
  catchit
)

efernal

  • Newt
  • Posts: 198
Re: Examples of usage GRREAD - let's share
« Reply #84 on: March 06, 2011, 11:48:16 AM »
Code: [Select]
;; wrote by eduardo fernal
;; 02/2011
(DEFUN c:teste (/ p1 e1 hf osmode attreq attdia cn)
  (SETQ osmode (GETVAR "OSMODE")
        cn     0
  )
  (SETVAR "OSMODE" 0)
  (IF (NULL (TBLSEARCH "BLOCK" "EfPac0173"))
    (PROGN (IF (NULL (TBLSEARCH "STYLE" "Tempsitc"))
             (ENTMAKE '((0 . "STYLE")
                        (100 . "AcDbSymbolTableRecord")
                        (100 . "AcDbTextStyleTableRecord")
                        (2 . "Tempsitc")
                        (70 . 0)
                        (40 . 0.0)
                        (41 . 1.0)
                        (50 . 0.0)
                        (71 . 0)
                        (42 . 1.0)
                        (3 . "TEMPSITC.TTF")
                        (4 . "")
                       )
             )
           )
           (ENTMAKE '((0 . "BLOCK") (2 . "EfPac0173") (70 . 2) (10 0.0 0.0 0.0)))
           (ENTMAKE '((0 . "ATTDEF")
                      (100 . "AcDbEntity")
                      (8 . "0")
                      (100 . "AcDbText")
                      (10 3.93553 7.30553 0.0)
                      (40 . 1.0)
                      (1 . "")
                      (50 . 0.0)
                      (41 . 1.0)
                      (51 . 0.0)
                      (7 . "Tempsitc")
                      (71 . 0)
                      (72 . 0)
                      (11 0.0 0.0 0.0)
                      (100 . "AcDbAttributeDefinition")
                      (280 . 0)
                      (3 . "Norte")
                      (2 . "1")
                      (70 . 0)
                      (73 . 0)
                      (74 . 0)
                      (280 . 1)
                     )
           )
           (ENTMAKE '((0 . "ATTDEF")
                      (100 . "AcDbEntity")
                      (8 . "0")
                      (100 . "AcDbText")
                      (10 3.93553 5.64553 0.0)
                      (40 . 1.0)
                      (1 . "")
                      (50 . 0.0)
                      (41 . 1.0)
                      (51 . 0.0)
                      (7 . "Tempsitc")
                      (71 . 0)
                      (72 . 0)
                      (11 0.0 0.0 0.0)
                      (100 . "AcDbAttributeDefinition")
                      (280 . 0)
                      (3 . "Leste")
                      (2 . "2")
                      (70 . 0)
                      (73 . 0)
                      (74 . 0)
                      (280 . 1)
                     )
           )
           (ENTMAKE '((0 . "ATTDEF")
                      (100 . "AcDbEntity")
                      (8 . "0")
                      (100 . "AcDbText")
                      (10 3.93553 3.98553 0.0)
                      (40 . 1.0)
                      (1 . "")
                      (50 . 0.0)
                      (41 . 1.0)
                      (51 . 0.0)
                      (7 . "Tempsitc")
                      (71 . 0)
                      (72 . 0)
                      (11 0.0 0.0 0.0)
                      (100 . "AcDbAttributeDefinition")
                      (280 . 0)
                      (3 . "Cota")
                      (2 . "3")
                      (70 . 0)
                      (73 . 0)
                      (74 . 0)
                      (280 . 1)
                     )
           )
           (ENTMAKE '((0 . "ATTDEF")
                      (100 . "AcDbEntity")
                      (8 . "0")
                      (100 . "AcDbText")
                      (10 3.93553 1.98553 0.0)
                      (40 . 1.0)
                      (1 . "")
                      (50 . 0.0)
                      (41 . 1.0)
                      (51 . 0.0)
                      (7 . "Tempsitc")
                      (71 . 0)
                      (72 . 0)
                      (11 0.0 0.0 0.0)
                      (100 . "AcDbAttributeDefinition")
                      (280 . 0)
                      (3 . "Descrição")
                      (2 . "4")
                      (70 . 0)
                      (73 . 0)
                      (74 . 0)
                      (280 . 1)
                     )
           )
           (ENTMAKE '((0 . "LWPOLYLINE")
                      (100 . "AcDbEntity")
                      (8 . "0")
                      (100 . "AcDbPolyline")
                      (90 . 7)
                      (70 . 0)
                      (43 . 0.0)
                      (38 . 0.0)
                      (39 . 0.0)
                      (10 2.05061 2.05061)
                      (40 . 0.0)
                      (41 . 0.0)
                      (42 . 0.437869)
                      (91 . 0)
                      (10 1.4632 2.02708)
                      (40 . 0.0)
                      (41 . 0.0)
                      (42 . 0.0)
                      (91 . 0)
                      (10 0.0 0.0)
                      (40 . 0.0)
                      (41 . 0.0)
                      (42 . 0.0)
                      (91 . 0)
                      (10 2.02708 1.4632)
                      (40 . 0.0)
                      (41 . 0.0)
                      (42 . 0.437869)
                      (91 . 0)
                      (10 2.05061 2.05061)
                      (40 . 0.0)
                      (41 . 0.0)
                      (42 . 0.0)
                      (91 . 0)
                      (10 3.53553 3.53553)
                      (40 . 0.0)
                      (41 . 0.0)
                      (42 . 0.0)
                      (91 . 0)
                      (10 13.5355 3.53553)
                      (40 . 0.0)
                      (41 . 0.0)
                      (42 . 0.0)
                      (91 . 0)
                     )
           )
           (ENTMAKE '((0 . "ENDBLK")))
    )
    nil
  )
  (SETVAR "OSMODE" 8)
  (IF (OR (NOT g::efpac0173::hf)
          (NOT (NUMBERP g::efpac0173::hf))
          (<= g::efpac0173::hf 0.0)
      )
    (SETQ g::efpac0173::hf 1.0)
  )
  (SETQ
    hf (GETREAL (STRCAT "\n-> Altura da fonte (font height) < " (RTOS g::efpac0173::hf 2 1) " > : "))
  )
  (IF (OR (NOT hf) (NOT (NUMBERP hf)) (<= hf 0))
    (SETQ hf g::efpac0173::hf)
  )
  (SETQ g::efpac0173::hf hf
        attreq (GETVAR "ATTREQ")
        attdia (GETVAR "ATTDIA")
  )
  (SETVAR "ATTREQ" 1)
  (SETVAR "ATTDIA" 0)
  ;;(PRINC "\n-> Tecle algo para encerrar ou posicione o cursor sobre pontos...")
  (princ "\n-> Type a letter for finish or put cursor over points...")
  (WHILE (LISTP (SETQ p1 (CADR (GRREAD 1 5 0))))
    (IF (SETQ e1 (SSGET "C"
                        (LIST (- (CAR p1) 0.001) (- (CADR p1) 0.001) (CADDR p1))
                        (LIST (+ (CAR p1) 0.001) (+ (CADR p1) 0.001) (CADDR p1))
                        (LIST (CONS 0 "POINT"))
                 )
        )
      (PROGN
        (SETQ e1 (ENTGET (SSNAME e1 0))
              p1 (CDR (ASSOC 10 e1))
              p3 (MAPCAR '+ '(5 5 0) p1)
        )
        (IF (NOT (SSGET "x" (LIST (CONS 0 "INSERT") (CONS 2 "EfPac0173") (CONS 10 p1))))
          (COMMAND "_.-INSERT"
                   "EfPac0173"
                   "_NON"
                   p1
                   g::efpac0173::hf
                   g::efpac0173::hf
                   0.0
                   (STRCAT "N=" (RTOS (CADR p1) 2 3))
                   (STRCAT "L=" (RTOS (CAR p1) 2 3))
                   (STRCAT "E=" (RTOS (CADDR p1) 2 3))
                   (ITOA (SETQ cn (1+ cn)))
          )
        )
      )
    )
  )
  (SETVAR "OSMODE" osmode)
  (SETVAR "ATTREQ" attreq)
  (SETVAR "ATTDIA" attdia)
  (PRINC)
)
« Last Edit: March 06, 2011, 05:55:31 PM by CAB »
e.fernal

Lee Mac

  • Seagull
  • Posts: 12372
  • London, England
Re: Examples of usage GRREAD - let's share
« Reply #85 on: March 06, 2011, 01:18:51 PM »
Efernal,

Please read this.

stevesfr

  • Newt
  • Posts: 54
Re: Examples of usage GRREAD - let's share
« Reply #86 on: March 06, 2011, 01:58:28 PM »
;;   wrote by eduardo fernal
;;   02/2011
(DEFUN c:teste (/ p1 e1 hf osmode attreq attdia cn)
.........


Well, I sure can't get this to work! ! ! !
« Last Edit: March 06, 2011, 05:53:54 PM by CAB »
Can't remember what I'm supposed to forget.

Lee Mac

  • Seagull
  • Posts: 12372
  • London, England
Re: Examples of usage GRREAD - let's share
« Reply #87 on: March 06, 2011, 02:35:23 PM »
It does have a dependence on the TTF file being available.

I have modified it slightly, perhaps try the attached.
« Last Edit: March 07, 2011, 04:11:00 PM by Lee Mac »

stevesfr

  • Newt
  • Posts: 54
Re: Examples of usage GRREAD - let's share
« Reply #88 on: March 06, 2011, 03:04:12 PM »
Lee,
perfect, thank you sir.....
Steve
Can't remember what I'm supposed to forget.

Lee Mac

  • Seagull
  • Posts: 12372
  • London, England
Re: Examples of usage GRREAD - let's share
« Reply #89 on: March 06, 2011, 03:32:10 PM »
Lee,
perfect, thank you sir.....
Steve

It could probably be streamlined should you have your own 'leader' block to insert, and I would probably opt to use VL to insert the block since entmaking the attribs is quite irritating. Or perhaps reverting back to the 'Insert' command is the easiest way to go.

Of course, the dynamicity could be replaced with just a selection prompt wherein the user could window over a set of points and label them all.