再次感谢各位
Z
干杯，伙计 哎哟，你把我割得很深，史瑞克
你的也不错Alan Zorg，试试这个
;; Switch/Match Text Valuesby Lee McDonnell
;; 09.06.2009
(defun c:tv (/ ent1 ent2 Str ss)
(vl-load-com)
(while
(not
(and (setq ent1 (car (nentsel "\nSelect Source Text: ")))
(member (cdadr (entget ent1))
'("MTEXT""TEXT""ATTRIB""MLEADER""ATTDEF"))))
(princ "\nMissed, Try Again. "))
(while
(progn
(not (initget "Match"))
(setq ent2 (entsel "\nSelect Text to Swap or <Match> : "))
(cond ((and (vl-consp ent2)
(member (cdadr (entget (car ent2)))
'("MTEXT""TEXT""ATTRIB""MLEADER""ATTDEF")))
(setq ent2 (car ent2)) nil)
((or (not ent2) (eq 'STR (type ent2)))
(if (setq ss (ssget '((0 . "*TEXT,ATTRIB,MLEADER,ATTDEF")))) nil t))
(T (princ "\nMissed, Try Again...")))))
(setq Str (vla-get-TextString
(vlax-ename->vla-object ent1)))
(cond (ss
(mapcar
(function
(lambda (x)
(vla-put-TextString x Str)))
(mapcar 'vlax-ename->vla-object
(vl-remove-if 'listp
(mapcar 'cadr (ssnamex ss))))))
(ent2
(setq Objlst (mapcar 'vlax-ename->vla-object (list ent1 ent2)))
(mapcar
(function
(lambda (Obj1 Str)
(vla-put-TextString Obj1 Str))) ObjLst
(mapcar 'vla-get-TextString (reverse ObjLst)))))
(princ))
哈哈，谢谢。
您应该用vl consp替换cond中的listp检查。如果变量为零，listp将返回T。现在，如果你错过了一个目标对象，它就会出错。当然，如果你错过了一个选择，这仍然会切换ssget&matching。 非常感谢Alan提供的提示，我不知道listp在提供nil参数时返回了T。
我会改变的
编辑：以上代码已更新~再次感谢Alan查看 在你们俩之间，我想你们可以自己动手
再次感谢各位
Z 佐尔格，
对这两个伟大的家伙没有冒犯之意，但来自asmi的这一个甚至更好。它也可以从动态块属性交叉匹配到常规文本。我不能从中获得任何荣誉，因为它是由ASMI创建的。
;; ============================================================ ;;
;; ;;
;;TTC.LSP - The program copies the text from: DText, MText, ;;
;; Tables, Dimensions, Attributes, Attributes, ;;
;; Attributes Definitions, DText, MText and inner ;;
;; block's DText and MText to: DText, MText, Tables, ;;
;; Attribures and Attributes Definitions. There are ;;
;; Multiple and Pair-wise modes. ;;
;; ;;
;; ============================================================ ;;
;; ;;
;;Command(s) to call: TTC ;;
;; ;;
;; ============================================================ ;;
;; ;;
;;THIS PROGRAM AND PARTS OF IT MAY REPRODUCED BY ANY METHOD ;;
;;ON ANY MEDIUM FOR ANY REASON. YOU CAN USE OR MODIFY THIS ;;
;;PROGRAM OR PARTS OF IT ABSOLUTELY FREE. ;;
;; ;;
;;THIS PROGRAM PROVIDES THIS PROGRAM 'AS IS' WITH ALL FAULTS ;;
;;AND SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY OF ;;
;;MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE. ;;
;; ;;
;; ============================================================ ;;
;; ;;
;;V1.3, 29 November, 2005, Riga, Latvia ;;
;;© Aleksandr Smirnov (ASMI) ;;
;;For AutoCAD 2000 - 2008 (isn't tested in a next versions) ;;
;; ;;
;; http://www.asmitools.com ;;
;; ;;
;; ============================================================ ;;
(defun c:ttc (/ actDoc vlaObj sObj sText curObj oldForm
oType oldMode conFlag errFlag *error*)
(vl-load-com)
(setq actDoc(vla-get-ActiveDocument
(vlax-get-acad-object)))
(vla-StartUndoMark actDoc)
(defun TTC_Paste(pasteStr / nslLst vlaObj hitPt
hitRes Row Column)
(setq errFlag nil)
(if
(setq nslLst(nentsel "\nPaste text >"))
(progn
(cond
((and
(= 4(length nslLst))
(= "DIMENSION"(cdr(assoc 0(entget(car(last nslLst))))))
); end and
(setq vlaObj(vlax-ename->vla-object
(cdr(assoc -1(entget(car(last nslLst)))))))
(if
(vl-catch-all-error-p
(vl-catch-all-apply
'vla-put-TextOverride(list vlaObj pasteStr)))
(progn
(princ "\n<!> Can't paste. Object may be on locked layer <!> ")
(setq errFlag T)
); end progn
); end if
); end condition #1
((and
(= 4(length nslLst))
(= "ACAD_TABLE"(cdr(assoc 0(entget(car(last nslLst))))))
); end and
(setq vlaObj
(vlax-ename->vla-object
(cdr(assoc -1(entget(car(last nslLst))))))
hitPt(vlax-3D-Point(trans(cadr nslLst)1 0))
hitRes(vla-HitTest vlaObj hitPt
(vlax-3D-Point '(0.0 0.0 1.0)) 'Row 'Column)
); end setq
(if(= :vlax-true hitRes)
(progn
(if(vl-catch-all-error-p
(vl-catch-all-apply
'vla-SetText(list vlaObj Row Column pasteStr)))
(progn
(princ "\n<!> Can't paste. Object may be on locked layer <!> ")
(setq errFlag T)
); end progn
); end if
); end progn
); end if
); end condition # 2
((and
(= 4(length nslLst))
(= "INSERT"(cdr(assoc 0(entget(car(last nslLst))))))
); end and
(princ "\n<!> Can't paste to block's DText or MText <!> ")
(setq errFlag T)
); end condition #3
((and
(= 2(length nslLst))
(member(cdr(assoc 0(entget(car nslLst))))
'("TEXT" "MTEXT" "ATTRIB" "ATTDEF"))
); end and
(setq vlaObj(vlax-ename->vla-object(car nslLst)))
(if(vl-catch-all-error-p
(vl-catch-all-apply
'vla-put-TextString(list vlaObj pasteStr)))
(progn
(princ "\n<!> Error. Can't pase text <!> ")
(setq errFlag T)
); end progn
); end if
); end condition #4
(T
(princ "\n<!> Can't paste. Invalid object <!> ")
(setq errFlag T)
); end condition #5
); end cond
T
); end progn
nil
); end if
); end of TTC_Paste
(defun TTC_MText_Clear(Mtext / Text Str)
(setq Text "")
(while(/= Mtext "")
(cond
((wcmatch(strcase
(setq Str
(substr Mtext 1 2)))"\\[\\{}`~]")
(setq Mtext(substr Mtext 3)
Text(strcat Text Str)
); end setq
); end condition #1
((wcmatch(substr Mtext 1 1) "[{}]")
(setq Mtext
(substr Mtext 2))
); end condition #2
((and
(wcmatch
(strcase
(substr Mtext 1 2)) "\\P")
(/=(substr Mtext 3 1) " ")
); end and
(setq Mtext (substr Mtext 3)
Text (strcat Text " ")
); end setq
); end condition #3
((wcmatch
(strcase
(substr Mtext 1 2)) "\\")
(setq Mtext(substr Mtext 3))
); end condition #4
((wcmatch
(strcase
(substr Mtext 1 2)) "\\")
(setq Mtext
(substr Mtext
(+ 2(vl-string-search ";" Mtext))))
); end condition #5
((wcmatch
(strcase (substr Mtext 1 2)) "\\S")
(setq Str(substr Mtext 3 (- (vl-string-search ";" Mtext) 2))
Text(strcat Text (vl-string-translate "#^\\" " " Str))
Mtext(substr Mtext (+ 4 (strlen Str)))
); end setq
(print Str)
); end condition #6
(T(setq Text(strcat Text(substr Mtext 1 1))
Mtext (substr Mtext 2)
); end setq
); end condition #7
); end cond
); end while
Text
); end of TTC_MText_Clear
(defun TTC_Copy (/ sObj sText tType actDoc)
(if
(and
(setq sObj(car(nentsel "\nCopy text... ")))
(member(setq tType(cdr(assoc 0(entget sObj))))
'("TEXT" "MTEXT" "ATTRIB" "ATTDEF"))
); end and
(progn
(setq actDoc(vla-get-ActiveDocument
(vlax-get-Acad-object))
sText(vla-get-TextString
(vlax-ename->vla-object sObj))
); end setq
(if(= tType "MTEXT")
(setq sText(TTC_MText_Clear sText))
); end if
); end progn
); end if
sText
); end of TTC_Copy
(defun CCT_Str_Echo(paseStr / comStr)
(if(< 20(strlen paseStr))
(setq comStr
(strcat
(substr paseStr 1 17)"..."))
(setq comStr paseStr)
); end if
(princ(strcat "\nText = \"" comStr "\""))
(princ)
); end of CCT_Str_Echo
(defun *error*(msg)
(vla-EndUndoMark
(vla-get-ActiveDocument
(vlax-get-acad-object)))
(princ "\nQuit TTC")
(princ)
); end of *error*
(if(not ttc:Mode)(setq ttc:Mode "Multiple"))
(initget "Multiple Pair-wise")
(setq oldMode ttc:Mode
ttc:Mode(getkword
(strcat "\nSpecify mode <"ttc:Mode">: "))
conFlag T
paseStr ""
); end setq
(if(null ttc:Mode)(setq ttc:Mode oldMode))
(if(= ttc:Mode "Multiple")
(progn
(if(and(setq paseStr(TTC_Copy))conFlag)
(progn
(CCT_Str_Echo paseStr)
(while(setq conFlag(TTC_Paste paseStr))T
); end while
); end progn
); end if
); end progn
(progn
(while(and conFlag paseStr)
(setq paseStr(TTC_Copy))
(if(and paseStr conFlag)
(progn
(CCT_Str_Echo paseStr)
(setq errFlag T)
(while errFlag
(setq conFlag(TTC_Paste paseStr))
);end while
); end progn
); end if
); end while
); end progn
); end if
(vla-EndUndoMark actDoc)
(princ "\nQuit TTC")
(princ)
); end c:ttc
(princ "\n*** Type TTC to run text to text copy tool *** ")
页:
1
[2]