Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
8 replies to this topic

#1 colombus

colombus

    biết vẽ ellipse

  • Members
  • PipPip
  • 58 Bài viết
Điểm đánh giá: 3 (bình thường)

Đã gửi 08 September 2016 - 10:16 AM

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!


  • 0

#2 anti lazy

anti lazy

    biết lệnh erase

  • Members
  • PipPipPip
  • 107 Bài viết
Điểm đánh giá: 27 (tàm tạm)

Đã gửi 08 September 2016 - 10:27 AM

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


  • 0

#3 colombus

colombus

    biết vẽ ellipse

  • Members
  • PipPip
  • 58 Bài viết
Điểm đánh giá: 3 (bình thường)

Đã gửi 08 September 2016 - 10:37 AM

ĐỌC ở đây đi lazy

 

http://forums.autode...es/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.


  • 0

#4 anti lazy

anti lazy

    biết lệnh erase

  • Members
  • PipPipPip
  • 107 Bài viết
Điểm đánh giá: 27 (tàm tạm)

Đã gửi 08 September 2016 - 11:25 AM

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


  • 0

#5 colombus

colombus

    biết vẽ ellipse

  • Members
  • PipPip
  • 58 Bài viết
Điểm đánh giá: 3 (bình thường)

Đã gửi 08 September 2016 - 12:14 PM

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ả.


  • 0

#6 conghoa

conghoa

    biết lệnh attdef

  • Members
  • PipPipPipPipPipPip
  • 411 Bài viết
Điểm đánh giá: 88 (tàm tạm)

Đã gửi 08 September 2016 - 01:33 PM

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

  • 1

#7 colombus

colombus

    biết vẽ ellipse

  • Members
  • PipPip
  • 58 Bài viết
Điểm đánh giá: 3 (bình thường)

Đã gửi 08 September 2016 - 02:28 PM

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


  • 0

#8 conghoa

conghoa

    biết lệnh attdef

  • Members
  • PipPipPipPipPipPip
  • 411 Bài viết
Điểm đánh giá: 88 (tàm tạm)

Đã gửi 08 September 2016 - 02:37 PM

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

 

http://www.mediafire...chprop text.lsp


  • 1

#9 colombus

colombus

    biết vẽ ellipse

  • Members
  • PipPip
  • 58 Bài viết
Điểm đánh giá: 3 (bình thường)

Đã gửi 08 September 2016 - 02:52 PM

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!


  • 0