GeoGIS

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

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

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

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

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

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

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

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

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

					;-=================================-;
					;-           Text Finder           -;
					;-     (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:tfind()
  (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 07 if fail
  ; 02 Check passed input. If both nil, GOTO 03. If first string and second nil, GOTO 05. If Otherwise, return error and GOTO 07
  ; 03 Display menus and obtain data from user. If Search, GOTO 04.
  ; 04 Search option selected. Prompt user for single search term. GOTO 05
  ; 05 One string has been passed. Assume automatic search. Run same as current (tfind). GOTO FINISH
  ; 07 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 7))
       )
      ((= goTo 2)
       ; Check input, pass to whatever.
       (cond
     ((= inputF nil)
      (setq goTo 3)
      )
     ((= (type inputF) 'STR)
      (setq strinF inputF)
      (setq goTo 5)
      )
     (t
      (setq error "\nPassed arguments are not accepted.")
      (setq goTo 7)
      )
     )
       )
      ((= goTo 3)
       ; Obtain desired option from user
       (while (not (mlml (list (setq searep (strcase (getstring nil "\nSelect option [Find/Quit/Case]: "))))
                 (list "F" "FIND" "Q" "QUIT" "C" "CASE")
                 ))
     )
       (cond
     ((mlml (list searep) (list "F" "FIND"))
      (setq goTo 4)
      )
     ((mlml (list searep) (list "Q" "QUIT"))
      (setq goTo 7)
      )
     ((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 5)
       )
      ((= goTo 5)
       ; 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) (* 20 (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) (* 20 (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 7)
       )
      ((= goTo 7)
       (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))
      )
    )
      );end 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

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

;- Text Finder -;

;- (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:tfind()

(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 07 if fail

; 02 Check passed input. If both nil, GOTO 03. If first string and second nil, GOTO 05. If Otherwise, return error and GOTO 07

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

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

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

; 07 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 7))

)

((= goTo 2)

; Check input, pass to whatever.

(cond

((= inputF nil)

(setq goTo 3)

)

((= (type inputF) 'STR)

(setq strinF inputF)

(setq goTo 5)

)

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

(setq goTo 7)

)

((= goTo 3)

; Obtain desired option from user

(while (not (mlml (list (setq searep (strcase (getstring nil "\nSelect option [Find/Quit/Case]: "))))

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

))

)

(cond

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

(setq goTo 4)

)

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

(setq goTo 7)

)

((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 5)

)

((= goTo 5)

; 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) (* 20 (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) (* 20 (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 7)

)

((= goTo 7)

(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))

)

);end 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) نوشته شده است و اینتر کنند. نامه این برنامه برای اجرا tfind است.

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

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

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

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