GeoGIS

برنامه ای برای یافتن یا جایگزین کردن متن در نرم افزارهای اتودسک

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

در زیر برنامه‌ای کاربردی برای یافتن (Find) یا جایگزین کردن(Replace) متن‌های موجود در سند نرم افزارهای اتودسک(اتوکد، لنددسکتاپ، سیویل تری دی)، قرار داده شده است. پس از نصب این فایل بسیار کوچک، چهار گزینه زیر در اختیار کاربر قرار می‌گیری:

۱- گزینه یافتن (Find): با انتخاب این گزینه کاربر می‌تواند با وارد کردن متن مورد نظر به مکان یا مکان‌هایی که شامل این متن می‌باشد مراجعه کند.

۲- گزینه جایگزین کردن (Replace): با انتخاب این گزینه کاربر می‌تواند با وارد کردن متن مورد نظر به مکان یا مکان‌هایی که شامل این متن می‌باشد رفته و آن را با مقدار پیشنهادی جدید جایگزین کند.

۳- گزینه خارج شدن از برنامه (Quit): با انتخاب این گزینه کاربر می‌تواند از برنامه خارج شود.

۴- گزینه حساسیت به کلمه (Case): با انتخاب این گزینه کاربر می‌تواند برای برنامه تعریف کند که به حروف بزرگ یا کوچک حساس باشد یا نه.

نکته : این برنامه امکان یافتن انواع متن از نوع تک نوشته(Text)، چند نوشته ای(Mtext)، بلوک(Block) و توصیفات(Attribute) را دارد.

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

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

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


; Improvements:
; Text within blocks
; Improved selection set.. maybe do away with the whole "list" thing and go straight VLA

(defun c:tfindr()
  (tfindfun nil nil 0)
  )

(defun tfindfun(inputF inputR caseSn / goto goWhile strinF strinR selSet selTxt searep case count error)
  ; 01 Create selection set. GOTO 02 if success, or GOTO 08 if fail
  ; 02 Check passed input. If both nil, GOTO 03. If first string and second nil, GOTO 06. If both strings, GOTO 07.
  ; Otherwise, return error and GOTO 08
  ; 03 Display menus and obtain data from user. If Search, GOTO 04. If Replace, GOTO 05
  ; 04 Search option selected. Prompt user for single search term. GOTO 06
  ; 05 Replace option selected. Prompt user for search term and replace term. GOTO 07
  ; 06 One string has been passed. Assume automatic search. Run same as current (tfindr). GOTO FINISH
  ; 07 Two strings have been passed. Assume automatic replace. Pass both strings to (replace) function. GOTO FINISH
  ; 08 FINISH. Return errors if needed. End loop and program.
  (vl-load-com)
  (setq goTo 1)
  (setq goWhile 1)
  (setq count 0)
  (if (not (mlml (list caseSn) (list 0 1))) (progn (setq goWhile nil) (princ "\nCase selection not recognized.")))
  (if (= caseSn 0) (setq case "N") (setq case "Y"))
  (while goWhile
    (cond
      ((= goTo 1)
       (setq selSet (extTxtPt (ssget "_X" (list
					    (cons -4 "<OR")
					    (cons 0 "TEXT,MTEXT")
					    (cons -4 "<AND")
					    (cons 0 "INSERT")
					    (cons 66 1)
					    (cons -4 "AND>")
					    (cons -4 "OR>")))))
       (if selSet (setq goTo 2) (setq error "\nSelection set not found." goTo 8))
       )
      ((= goTo 2)
       ; Check input, pass to whatever.
       (cond
     ((and (= inputF nil) (= inputR nil))
      (setq goTo 3)
      )
     ((and (= (type inputF) 'STR) (= inputR nil))
      (setq strinF inputF)
      (setq goTo 6)
      )
     ((and (= (type inputF) 'STR) (= (type inputR) 'STR))
      (setq strinF inputF)
      (setq strinR inputR)
      (setq goTo 7)
      )
     (t
      (setq error "\nPassed arguments are not accepted.")
      (setq goTo 8)
      )
     )
       )
      ((= goTo 3)
       ; Obtain desired option from user
       (while (not (mlml (list (setq searep (strcase
					      (getstring nil "\nSelect option [Find/Replace/Quit/Case]: "))))
                 (list "F" "FIND" "R" "REPLACE" "Q" "QUIT" "C" "CASE")
                 ))
     )
       (cond
     ((mlml (list searep) (list "F" "FIND"))
      (setq goTo 4)
      )
     ((mlml (list searep) (list "R" "REPLACE"))
      (setq goTo 5)
      )
     ((mlml (list searep) (list "Q" "QUIT"))
      (setq goTo 8)
      )
     ((mlml (list searep) (list "C" "CASE"))
      (while (not (mlml (list (setq case (strcase
					   (getstring nil "\nCase sensitive? [Yes/No]: "))))
                    (list "Y" "YES" "N" "NO")
                    ))
        )
      )
     )
       )
      ((= goTo 4)
       ; Obtain search string from user, set to strinF
       (while (eq "" (setq strinF (getstring T "\nEnter search term: "))))
       (setq goTo 6)
       )
      ((= goTo 5)
       ; Obtain search string and replace string from user, set to strinF and strinR respectively
       (while (eq "" (setq strinF (getstring T "\nEnter find term: "))))
       (while (eq "" (setq strinR (getstring T "\nEnter replace term: "))))
       (setq goTo 7)
       )
      ((= goTo 6)
       ; Search drawing for strinF
       (cond
     ((mlml (list case) (list "Y" "YES"))
      ; Compare using (vl-string-search strinF input), view selection
      ; use "while" to get all search occurances
      (foreach selVar selSet
        (if (vl-string-search strinF (nth 0 selVar))
          (progn
        (setq count (1+ count))
        (if (/= (getvar "ctab") (caddr selVar)) (command "ctab" (caddr selVar)))
        (command "zoom" "c" (trans (cadr selVar) 0 1) (* 32 (nth 3 selVar)))
        (getstring "\nPress 'Enter' to continue: ")
        )
          )
        )
      )
     ((mlml (list case) (list "N" "NO"))
      ; Compare using (vl-string-search (strcase strinF) (strcase input)), view selection
      ; use "while" to get all search occurances
      (foreach selVar selSet
        (if (vl-string-search (strcase strinF) (strcase (nth 0 selVar)))
          (progn
        (setq count (1+ count))
        (if (/= (getvar "ctab") (caddr selVar)) (command "ctab" (caddr selVar)))
        (command "zoom" "c" (trans (cadr selVar) 0 1) (* 32 (nth 3 selVar)))
        (getstring "\nPress 'Enter' to continue: ")
        )
          )
        )
      )
     )
       (if (= count 0) (setq error "\nNo matches found.")
	 (setq error (strcat (itoa count) " matches found.")))
       (setq goTo 8)
       )
      ((= goTo 7)
       ; Replace strinF with strinR
       (cond
     ((mlml (list case) (list "Y" "YES"))
      ; Compare using (vl-search-string strinF input), modify using (vl-string-subst) within a while loop
      (foreach selVar selSet
        (setq selTxt (nth 0 selVar))
        (setq seaLoc 0)
        (while (setq seaLoc (vl-string-search strinF selTxt seaLoc))
          (setq selTxt (vl-string-subst strinR strinF selTxt seaLoc))
          (setq seaLoc (+ seaLoc (strlen strinR)))
          (setq count (1+ count))
          )
        (vla-put-TextString (vlax-ename->vla-object (nth 4 selVar)) selTxt)
        )
      )
     ((mlml (list case) (list "N" "NO"))
      ; Compare using (vl-string-search (strcase strinF) (strcase input)), modify using (vl-string-subst) within a while loop
      (foreach selVar selSet
        (setq selTxt (nth 0 selVar))
        (setq seaLoc 0)
        (while (setq seaLoc (vl-string-search (strcase strinF) (strcase selTxt) seaLoc))
          (setq selTxt (strcat (substr selTxt 1 seaLoc) strinR (substr selTxt (+ 1 seaLoc (strlen strinF)))))
          (setq seaLoc (+ seaLoc (strlen strinR)))
          (setq count (1+ count))
          )
        (vla-put-TextString (vlax-ename->vla-object (nth 4 selVar)) selTxt)
        )
      )
     )
       (if (= count 0) (setq error "\nNo occurances found.")
	 (setq error (strcat (itoa count) " occurances modified.")))
       (setq goTo 8)
       )
      ((= goTo 8)
       (if error (princ error))
       (setq goWhile nil)
       )
      )
    )
  (princ)
  )

(defun mlml(inSMLChar inSMLStri / returnVarMS toCheck chkWith)
  (setq returnVarMS nil)
  (if (and (= (type inSMLChar) 'LIST)
       (= (type inSMLStri) 'LIST)
       )
    (progn
      (foreach toCheck inSMLStri
    (foreach chkWith inSMLChar
      (if (eq toCheck chkWith) (setq returnVarMS T))
      )
    )
      ); progn
    )
  returnVarMS
  ); Checks a list to see if a member of that list is the same as a member of another list. Returns T or nil

(defun extTxtPt(ssList / subVar getEnt entTyp entTxt entPnt entLay entHgt grp66 entAtt getEntAtt entAttTyp uniLst)
  (setq uniLst nil)
  (setq subVar 0)
  (if ssList
  (repeat (sslength ssList)
    (setq getEnt (entget (cadr (car (ssnamex ssList subVar)))))
    (setq entTyp (cdr (assoc 0 getEnt)))
    (cond
      ((or (= entTyp "TEXT") (= entTyp "MTEXT"))
       (setq entTxt (cdr (assoc 1 getEnt)))
       (setq entPnt (cdr (assoc 10 getEnt)))
       (setq entHgt (cdr (assoc 40 getEnt)))
       (setq entLay (cdr (assoc 410 getEnt)))
       (setq entNam (cdr (assoc -1 getEnt)))

       (setq uniLst (append uniLst (list (list entTxt entPnt entLay entHgt entNam))))
       )
      ((= entTyp "INSERT")
       (setq grp66 (assoc 66 getEnt))
       (if grp66
     (progn
       (setq entAtt (entnext (cdr (assoc -1 getEnt))))
           (setq getEntAtt (entget entAtt))
           (setq entAttTyp (cdr (assoc 0 getEntAtt)))
       )
     )
       (while (= entAttTyp "ATTRIB")
     (setq entTxt (cdr (assoc 1 getEntAtt)))
     (setq entPnt (cdr (assoc 10 getEntAtt)))
         (setq entHgt (cdr (assoc 40 getEntAtt)))
     (setq entLay (cdr (assoc 410 getEntAtt)))
     (setq entNam (cdr (assoc -1 getEntAtt)))
     
     (setq uniLst (append uniLst (list (list entTxt entPnt entLay entHgt entNam))))

     ; Get next entity.
     (setq entAtt (entnext (cdr (assoc -1 getEntAtt))))

     ; Get ent and ent type
     (setq getEntAtt (entget entAtt))
     (setq entAttTyp (cdr (assoc 0 getEntAtt)))
     )
       )
      (t
       )
      )
    (setq subVar (1+ subVar))
    )
    )
  uniLst
  ); Return list of all text-based objects (Text, MText, Attribute) in the current drawing

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

219

220

221

222

223

224

225

226

227

228

229

230

231

232

233

234

235

236

237

238

239

240

241

242

243

244

245

246

247

248

249

250

251

252

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

;- Find and replace text -;

;- (Option Case sensitive) -;

;- Tested on AutoCAD 2002-2014 -;

;- Written by -;

;- Ebrahim Rastgou -;

;- WWW.GeoGIS.ir -;

;- 05-02-14 -;

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

; Improvements:

; Text within blocks

; Improved selection set.. maybe do away with the whole "list" thing and go straight VLA

(defun c:tfindr()

(tfindfun nil nil 0)

)

(defun tfindfun(inputF inputR caseSn / goto goWhile strinF strinR selSet selTxt searep case count error)

; 01 Create selection set. GOTO 02 if success, or GOTO 08 if fail

; 02 Check passed input. If both nil, GOTO 03. If first string and second nil, GOTO 06. If both strings, GOTO 07.

; Otherwise, return error and GOTO 08

; 03 Display menus and obtain data from user. If Search, GOTO 04. If Replace, GOTO 05

; 04 Search option selected. Prompt user for single search term. GOTO 06

; 05 Replace option selected. Prompt user for search term and replace term. GOTO 07

; 06 One string has been passed. Assume automatic search. Run same as current (tfindr). GOTO FINISH

; 07 Two strings have been passed. Assume automatic replace. Pass both strings to (replace) function. GOTO FINISH

; 08 FINISH. Return errors if needed. End loop and program.

(vl-load-com)

(setq goTo 1)

(setq goWhile 1)

(setq count 0)

(if (not (mlml (list caseSn) (list 0 1))) (progn (setq goWhile nil) (princ "\nCase selection not recognized.")))

(if (= caseSn 0) (setq case "N") (setq case "Y"))

(while goWhile

(cond

((= goTo 1)

(setq selSet (extTxtPt (ssget "_X" (list

(cons -4 "<OR")

(cons 0 "TEXT,MTEXT")

(cons -4 "<AND")

(cons 0 "INSERT")

(cons 66 1)

(cons -4 "AND>")

(cons -4 "OR>")))))

(if selSet (setq goTo 2) (setq error "\nSelection set not found." goTo 8))

)

((= goTo 2)

; Check input, pass to whatever.

(cond

((and (= inputF nil) (= inputR nil))

(setq goTo 3)

)

((and (= (type inputF) 'STR) (= inputR nil))

(setq strinF inputF)

(setq goTo 6)

)

((and (= (type inputF) 'STR) (= (type inputR) 'STR))

(setq strinF inputF)

(setq strinR inputR)

(setq goTo 7)

)

(setq error "\nPassed arguments are not accepted.")

(setq goTo 8)

)

((= goTo 3)

; Obtain desired option from user

(while (not (mlml (list (setq searep (strcase

(getstring nil "\nSelect option [Find/Replace/Quit/Case]: "))))

(list "F" "FIND" "R" "REPLACE" "Q" "QUIT" "C" "CASE")

))

)

(cond

((mlml (list searep) (list "F" "FIND"))

(setq goTo 4)

)

((mlml (list searep) (list "R" "REPLACE"))

(setq goTo 5)

)

((mlml (list searep) (list "Q" "QUIT"))

(setq goTo 8)

)

((mlml (list searep) (list "C" "CASE"))

(while (not (mlml (list (setq case (strcase

(getstring nil "\nCase sensitive? [Yes/No]: "))))

(list "Y" "YES" "N" "NO")

))

)

((= goTo 4)

; Obtain search string from user, set to strinF

(while (eq "" (setq strinF (getstring T "\nEnter search term: "))))

(setq goTo 6)

)

((= goTo 5)

; Obtain search string and replace string from user, set to strinF and strinR respectively

(while (eq "" (setq strinF (getstring T "\nEnter find term: "))))

(while (eq "" (setq strinR (getstring T "\nEnter replace term: "))))

(setq goTo 7)

)

((= goTo 6)

; Search drawing for strinF

(cond

((mlml (list case) (list "Y" "YES"))

; Compare using (vl-string-search strinF input), view selection

; use "while" to get all search occurances

(foreach selVar selSet

(if (vl-string-search strinF (nth 0 selVar))

(progn

(setq count (1+ count))

(if (/= (getvar "ctab") (caddr selVar)) (command "ctab" (caddr selVar)))

(command "zoom" "c" (trans (cadr selVar) 0 1) (* 32 (nth 3 selVar)))

(getstring "\nPress 'Enter' to continue: ")

)

((mlml (list case) (list "N" "NO"))

; Compare using (vl-string-search (strcase strinF) (strcase input)), view selection

; use "while" to get all search occurances

(foreach selVar selSet

(if (vl-string-search (strcase strinF) (strcase (nth 0 selVar)))

(progn

(setq count (1+ count))

(if (/= (getvar "ctab") (caddr selVar)) (command "ctab" (caddr selVar)))

(command "zoom" "c" (trans (cadr selVar) 0 1) (* 32 (nth 3 selVar)))

(getstring "\nPress 'Enter' to continue: ")

)

(if (= count 0) (setq error "\nNo matches found.")

(setq error (strcat (itoa count) " matches found.")))

(setq goTo 8)

)

((= goTo 7)

; Replace strinF with strinR

(cond

((mlml (list case) (list "Y" "YES"))

; Compare using (vl-search-string strinF input), modify using (vl-string-subst) within a while loop

(foreach selVar selSet

(setq selTxt (nth 0 selVar))

(setq seaLoc 0)

(while (setq seaLoc (vl-string-search strinF selTxt seaLoc))

(setq selTxt (vl-string-subst strinR strinF selTxt seaLoc))

(setq seaLoc (+ seaLoc (strlen strinR)))

(setq count (1+ count))

)

(vla-put-TextString (vlax-ename->vla-object (nth 4 selVar)) selTxt)

)

((mlml (list case) (list "N" "NO"))

; Compare using (vl-string-search (strcase strinF) (strcase input)), modify using (vl-string-subst) within a while loop

(foreach selVar selSet

(setq selTxt (nth 0 selVar))

(setq seaLoc 0)

(while (setq seaLoc (vl-string-search (strcase strinF) (strcase selTxt) seaLoc))

(setq selTxt (strcat (substr selTxt 1 seaLoc) strinR (substr selTxt (+ 1 seaLoc (strlen strinF)))))

(setq seaLoc (+ seaLoc (strlen strinR)))

(setq count (1+ count))

)

(vla-put-TextString (vlax-ename->vla-object (nth 4 selVar)) selTxt)

)

(if (= count 0) (setq error "\nNo occurances found.")

(setq error (strcat (itoa count) " occurances modified.")))

(setq goTo 8)

)

((= goTo 8)

(if error (princ error))

(setq goWhile nil)

)

(princ)

)

(defun mlml(inSMLChar inSMLStri / returnVarMS toCheck chkWith)

(setq returnVarMS nil)

(if (and (= (type inSMLChar) 'LIST)

(= (type inSMLStri) 'LIST)

)

(progn

(foreach toCheck inSMLStri

(foreach chkWith inSMLChar

(if (eq toCheck chkWith) (setq returnVarMS T))

)

); progn

)

returnVarMS

); Checks a list to see if a member of that list is the same as a member of another list. Returns T or nil

(defun extTxtPt(ssList / subVar getEnt entTyp entTxt entPnt entLay entHgt grp66 entAtt getEntAtt entAttTyp uniLst)

(setq uniLst nil)

(setq subVar 0)

(if ssList

(repeat (sslength ssList)

(setq getEnt (entget (cadr (car (ssnamex ssList subVar)))))

(setq entTyp (cdr (assoc 0 getEnt)))

(cond

((or (= entTyp "TEXT") (= entTyp "MTEXT"))

(setq entTxt (cdr (assoc 1 getEnt)))

(setq entPnt (cdr (assoc 10 getEnt)))

(setq entHgt (cdr (assoc 40 getEnt)))

(setq entLay (cdr (assoc 410 getEnt)))

(setq entNam (cdr (assoc -1 getEnt)))

(setq uniLst (append uniLst (list (list entTxt entPnt entLay entHgt entNam))))

)

((= entTyp "INSERT")

(setq grp66 (assoc 66 getEnt))

(if grp66

(progn

(setq entAtt (entnext (cdr (assoc -1 getEnt))))

(setq getEntAtt (entget entAtt))

(setq entAttTyp (cdr (assoc 0 getEntAtt)))

)

(while (= entAttTyp "ATTRIB")

(setq entTxt (cdr (assoc 1 getEntAtt)))

(setq entPnt (cdr (assoc 10 getEntAtt)))

(setq entHgt (cdr (assoc 40 getEntAtt)))

(setq entLay (cdr (assoc 410 getEntAtt)))

(setq entNam (cdr (assoc -1 getEntAtt)))

(setq uniLst (append uniLst (list (list entTxt entPnt entLay entHgt entNam))))

; Get next entity.

(setq entAtt (entnext (cdr (assoc -1 getEntAtt))))

; Get ent and ent type

(setq getEntAtt (entget entAtt))

(setq entAttTyp (cdr (assoc 0 getEntAtt)))

)

(setq subVar (1+ subVar))

)

uniLst

); Return list of all text-based objects (Text, MText, Attribute) in the current drawing

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

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

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

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

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

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