[Yêu Cầu] Gán Giá Trị Của Dimension Cho Nhiều Text Có Sẵn

[colombus 3]

Chào các bạn,

 

Tôi đã tìm kiếm cách giải quyết này google trên cadviet và các web nước ngoài nhưng vẫn chưa tìm được. Mong các bạn giúp cho.

 

Yêu cầu là click vô dimension sau đó click vô các text có sẵn trên bản vẽ LẦN LƯỢT TỪNG CÁI hoặc CHỌN CỬA SỔ cho một nhóm text. Enter để cho kết quả và kết thúc lệnh.

 

Xin cảm ơn!

[anti lazy 28]

Tôi cũng tìm nhưng không thấy ai từ 1 tuổi lên 3 tuổi cả.

Chỉ có 1 tuổi lên 2 tuổi: lấy giá trị của dimension

và 2 tuổi lên 3 tuổi: gán nội dung cho text có sẵn mà thôi

[colombus 3]

ĐỌC ở đây đi lazy

 

http://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/need-text-from-dimension-values/td-p/6224878

người ta làm được cả đấy nhưng cái lisp đấy không phù hợp với yêu cầu của tôi thôi

 

Bởi vậy ku đâu có lớn nổi.

[anti lazy 28]

Hướng dẫn funny 1 chút thì đã phật lòng

Y/c của bạn còn đơn giản hơn, nếu có khung sẵn tôi sửa <= 10', nếu viết từ đầu cũng <=20'

 

Columbus của Spain ngày xưa tìm ra châu Mỹ

Columbus của cadviet không dám nhảy qua 1 con mương 0.5m

[colombus 3]

10' hay 20' đó là chuyện của you. Tôi chỉ đáp trả đúng mực. 

Columbus là người Portugal. Cái vui của you dĩ nhiên là không vui. Cú khích quá nhàm và không sát theo chủ đề. 

 

Tôi lấy nick Colombus không có gì gọi là ăn theo cả.

[conghoa 125]

@Colombus Bạn thử dùng lisp này xem. Nó như một dạng Matchprop text, Bạn có thể chọn copy text từ Dim, text, att, MText đến 1 text có sẵn mà bạn muốn.



Chạy lisp rồi bạn chọn Pair-wise nhé.

;;;Realization {Smirnoff}

;;; TTCM - Text to Text copy whith Matchprop. Copy text from DIMENSION, TEXT, 

;;;MTEXT, ATTRIB, ATTDEF, ACAD_TABLE to one

(defun c:ttcm (/ actDoc vlaObj sObj sText curObj oldForm

        oType oldMode conFlag errFlag *error* prop)

  (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 "\nCan't paste to block's DText or MText. Select Attribute ")

     (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 "\nError. Can't pase text. ")

      (setq errFlag T)

      ); end progn

     ); end if

     ); end condition #4

    (T

     (princ "\nCan't paste. Invalid object. ")

     (setq errFlag T)

     ); end condition #5

    ); end cond

    (if (and (null errFlag)

             (= (type vlaObj) 'VLA-OBJECT))

    (mapcar '(lambda (x y) (vlax-put-property vlaObj x y))

        '(Linetype LineWeight Color Layer)

        prop

        )

      )

             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)) "\\[LOP]")

    (setq Mtext(substr Mtext 3))

  ); end condition #4

  ((wcmatch

     (strcase

       (substr Mtext 1 2)) "\\[ACFHQTW]")

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

  (setq prop (mapcar '(lambda (x)

             (vlax-get-property (vlax-ename->vla-object sObj)  x))

      '(Linetype LineWeight Color Layer)

          )

        )

    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 TTCM")

    (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 [Multiple/Pair-wise] <" 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 TTCM")

  (princ)

  ); end c:ttc

(princ "\n\t TTCM - Text to Text copy with matchprop.")

(princ "\nCopy text from DIMENSION, TEXT, MTEXT, ATTRIB, ATTDEF, ACAD_TABLE to one")

[colombus 3]

Chào conghoa, tôi nhận được các thông báo sau: 

Command: ap

APPLOAD ttcm.lsp successfully loaded.

Command: ; error: syntax error

Command:

Hình như lisp này không nạp được . tôi dùng winXP 32bit, cad 2010.

Xin cảm ơn

[conghoa 125]

Bạn download lại lisp này xem

 

http://www.mediafire.com/download/0nz637j84fecau1/ttcm_matchprop+text.lsp

[colombus 3]

Vâng , hay hơn tôi mong đợi vì có 2 option Pair và Multiple cho 1 lần vào lệnh.

 

Xin cảm ơn conghoa. Chúc bạn thành công!

[colombus 3]

Khi gán text của dim cho text thì nó gán luôn cho text vào layer của dim. Trong khi đó ta thường tổ chức bản vẽ dim thuộc 1 layer còn text thì thuộc 1 layer khác. Nay lisp này làm cho text chuyển sang layer của dim luôn thì cũng hơi phiền.

 

Nếu bạn nào biết thì xin sửa lại lisp này giúp cho. Chỉ gán nội dung dim cho text chứ không cần gán layer.

 

Xin cảm ơn.

[hoquangvinh 7]

Bạn download lại lisp này xem

 

http://www.mediafire.com/download/0nz637j84fecau1/ttcm_matchprop+text.lsp

Sao mình thử lại bị lỗi này nhỉ

; error: no function definition: VLAX-GET-ACAD-OBJECT

mình dùng cad 2008