GeoGIS

سایتی در زمینه علوم ژئوماتیک

برنامه ای برای تغییر سریع و راحت متن (Text) در نرم افزارهای اتودسک

ارسال توسط راستگو در تاریخ ۲۹ - اردیبهشت - ۱۳۹۳

در زیر برنامه‌ای برای تغییر سریع متن (Text, Mtext) در سند نرم افزارهای اتودسک(اتوکد، لنددسکتاپ، سیویل تری دی)، قرار داده شده است. به کمک نصب این فایل بسیار کوچک، کاربر می‌تواند با کلیک روی هر متن (Text, Mtext)، و وارد کردن کاراکتر یا قسمتی از کااکترها یا تمام کلمه، آن را با مقداری دیگر تعویض کند.

دوستانی که نحوه‌ی فراخوانی فایل‌های لیسپ (LISP) را در نرم‌افزار‌های اتودسک نمی‌دانند، برای رفتن به صفحه آموزش فراخوانی فایل‌های لیسپ (LISP) در نرم‌افزار‌های اتودسک اینجا کلیک کنند.

برای دستیابی به موارد بالا، ابتدا کدهای زیر را در یک فایل متن (مانند نوتپد “Notpad”، ورد “Word” و …) کپی کرده و در نهایت پسوند فایل را به lsp. تغییر دهید.

					;-=================================-;
					;-      Find and replace text      -;
					;-  Tested on AutoCAD 2002-2014    -;
					;-           Written by            -;
					;-        Ebrahim Rastgou          -;
					;-         WWW.GeoGIS.ir           -;
					;-           05-02-14              -;
					;-=================================-;

;---------------function to find text string from text entity------------------
(defun gettxt ()
(setvar "osmode" 64)                                ;set osnap to insert
(setq pt1 (getpoint "\nPick text to edit: "))       ;get point on text
(Setvar "osmode" 0)                                 ;set osnap back to zero
(setq oldobj (entget (ssname (ssget pt1) 0) ))      ;get entity zero from prop.
(setq txtstr (assoc 1 oldobj))                      ;get list containing string
(cdr txtstr)                                        ;extract string from prop.
)
 
;-------------------function to update text string of text entity---------------
(defun revtxt ()
(setq newtxt (cons 1 newtxt))                       ;create replacement propty.
(entmod (subst newtxt txtstr oldobj))               ;update database
)
 
;------------------program to edit single line of text--------------------------
(defun c:CHTXT (/ count oldstr newstr osleng otleng oldt old1
                  old2 newtxt pt1 oldobj txtstr oldtxt)
(setq count 0)                                      ;setup counter to zero
(setq oldtxt (gettxt))                              ;get old string from text
(setq otleng (strlen oldtxt))                       ;find length of old string
(setq oldstr (getstring T "\nEnter old string: "))   ;get string to change
(Setq newstr (getstring T "\nEnter new string: "))   ;get replacement string
(setq osleng (strlen oldstr))                       ;find length of substring-
  ;while string to replace is not found, do...       to be replaced
  (while (and (/= oldstr oldt)(<= count otleng))
    (setq count (1+ count))                         ;add 1 to counter
    (setq oldt (substr oldtxt count osleng))        ;get substring to compare
  );end while
  ;if counting stops before end of old string is reached...
  (if (<= count otleng)
        (progn
           (setq old1 (substr oldtxt 1 (1- count))) ;get 1st half of old string
           (setq old2 (substr oldtxt (+ count osleng) otleng));get 2nd half
           (setq newtxt (strcat old1 newstr old2))  ;combine to make new string
           (revtxt)                                 ;update drawing
        )
        (princ "\nNo matching string found.")       ;else print message
  );end if
(PRINC)
);end C:EDTXT

;-=================================-;

;- Find and replace text -;

;- Tested on AutoCAD 2002-2014 -;

;- Written by -;

;- Ebrahim Rastgou -;

;- WWW.GeoGIS.ir -;

;- 05-02-14 -;

;-=================================-;

;---------------function to find text string from text entity------------------

(defun gettxt ()

(setvar "osmode" 64) ;set osnap to insert

(setq pt1 (getpoint "\nPick text to edit: ")) ;get point on text

(Setvar "osmode" 0) ;set osnap back to zero

(setq oldobj (entget (ssname (ssget pt1) 0) )) ;get entity zero from prop.

(setq txtstr (assoc 1 oldobj)) ;get list containing string

(cdr txtstr) ;extract string from prop.

)

;-------------------function to update text string of text entity---------------

(defun revtxt ()

(setq newtxt (cons 1 newtxt)) ;create replacement propty.

(entmod (subst newtxt txtstr oldobj)) ;update database

)

;------------------program to edit single line of text--------------------------

(defun c:CHTXT (/ count oldstr newstr osleng otleng oldt old1

old2 newtxt pt1 oldobj txtstr oldtxt)

(setq count 0) ;setup counter to zero

(setq oldtxt (gettxt)) ;get old string from text

(setq otleng (strlen oldtxt)) ;find length of old string

(setq oldstr (getstring T "\nEnter old string: ")) ;get string to change

(Setq newstr (getstring T "\nEnter new string: ")) ;get replacement string

(setq osleng (strlen oldstr)) ;find length of substring-

;while string to replace is not found, do... to be replaced

(while (and (/= oldstr oldt)(<= count otleng))

(setq count (1+ count)) ;add 1 to counter

(setq oldt (substr oldtxt count osleng)) ;get substring to compare

);end while

;if counting stops before end of old string is reached...

(if (<= count otleng)

(progn

(setq old1 (substr oldtxt 1 (1- count))) ;get 1st half of old string

(setq old2 (substr oldtxt (+ count osleng) otleng));get 2nd half

(setq newtxt (strcat old1 newstr old2)) ;combine to make new string

(revtxt) ;update drawing

)

(princ "\nNo matching string found.") ;else print message

);end if

(PRINC)

);end C:EDTXT

دوستانی که تمایل به کپی کردن کد برنامه را ندارند می‌توانند فایل لیسپ (LISP) برنامه بالا را از پیوندهای زیر دریافت نمایند.

برای اجرای این برنامه پس از دریافت و بارگذاری برنامه روی نرم افزار اتودسک خود، کافیست در خط فرمان نام اجرای برنامه که در خط تعریف برنامه (defun) نوشته شده است و اینتر کنند. نامه این برنامه برای اجرا chtxt است.

نکته : جزوات و اطلاعات این سایت به روز خواهند شد پس در زمان دانلود، به تاریخ انتشار آن توجه فرمایید.

حجم داده : ۲۳ کیلوبایت

تاریخ انتشار : ۹۳/۰۲/۲۹

دانلود : دانلود از لینک مستقیم