Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
Người theo dõi 0
Tuanhaxoai

Xin list fakedim ( cố định dim khi scale)

Bởi Tuanhaxoai , trong AutoLisp

Các bài được khuyến nghị

vietduc147258    51

vietduc147258
Đã đăng

Lisp này biết dim thành Text Override, cũng có tác dụng tương tự.

Cái này dùng khá là ức chế, không chọn nhiều đối tượng dim cùng lúc được

  

(defun C:DMTO ; = Dimension Measurement-Text Override
  (/ dimsel dim ddata)
  (if (setq dimsel (entsel "\nSelect Dimension to override text with measured distance: "))
    (progn
      (setq
        dim (car dimsel)
        ddata (entget dim)
      ); setq
      (entmod
        (subst
          (cons 1
            (cond
              ((member '(1 . "") ddata); text is only default [no override already]
                (rtos (cdr (assoc 42 ddata))); text equivalent of measured distance
              ); default condition
              ((wcmatch (cdr (assoc 1 ddata)) "*<>*"); override including measured distance
                (vl-string-subst (rtos (cdr (assoc 42 ddata))) "<>" (cdr (assoc 1 ddata)))
                  ; replace measured-distance portion with equivalent text override
              ); measured-distance-included condition
              ((strcat (rtos (cdr (assoc 42 ddata))) " " (cdr (assoc 1 ddata))))
                ; none-of-the-above; add measured-distance text to beginning of override
            ); cond
          ); cons
          (assoc 1 ddata)
          ddata
        ); subst
      ); entmod
    ); progn
  ); if
  (princ)
); defun

Lisp này lấy từ diễn đàn nước ngoài

bài viết gốc: https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/dimension-convet-to-text-lisp/td-p/7815197

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

vietduc147258    51

vietduc147258
Đã đăng

Bạn thử cái này nha

  

;;https://www.cadtutor.net/forum/topic/6657-copy-dimension-to-text-override/

;;Dim override
(defun c:dimo (/ COPYDIM CURLAY DELSET DIMLST
      DIMSET ERRCOUNT LAYCOL LENT
      NEXTENT OVTEXT *ERROR* ACTDOC
      OLDECHO)
;;; Vladimir Smirnov {Smirnoff} on dwg.ru
 (defun *ERROR* (msg)
   (setvar "CMDECHO" oldEcho)
   ); end of error
 (vl-load-com)
 (setq oldEcho(getvar "CMDECHO")
actDoc(vla-get-ActiveDocument
	      (vlax-get-acad-object))
layCol(vla-get-Layers actDoc)
); end setq
 (setvar "CMDECHO" 0)
 (if
   (setq dimSet
   (ssget "_:L" '((0 . "DIMENSION"))))
   (progn
     (setq dimLst
     (mapcar 'vlax-ename->vla-object 
                   (vl-remove-if 'listp 
                    (mapcar 'cadr(ssnamex dimSet))))
    ); end setq
     (vla-StartUndoMark actDoc)
     (foreach dim dimLst
     	(vla-put-TextOverride dim (dim-get-text-string (vlax-vla-object->ename dim)))
(vla-put-Color dim 22)
       )
     (vla-EndUndoMark actDoc)
     ); end progn
   ); end if
 (setvar "CMDECHO" oldEcho)
 (princ)
 ); end of c:dimo

(defun Col_Item_Find (Collection Item / result)
 (if
   (not
     (vl-catch-all-error-p  
(setq result
       (vl-catch-all-apply 'vla-item
	 (list Collection Item))))) 
   result
   ); end if
 ); end of Col_Item_Find
;;; Dim restore
(defun c:dimr (/ COPYDIM CURLAY DELSET DIMLST
      DIMSET ERRCOUNT LAYCOL LENT
      NEXTENT OVTEXT *ERROR* ACTDOC
      OLDECHO)
;;; Vladimir Smirnov {Smirnoff} on dwg.ru
 (defun *ERROR* (msg)
   (setvar "CMDECHO" oldEcho)
   ); end of error

 (vl-load-com)
 (setq oldEcho(getvar "CMDECHO")
actDoc(vla-get-ActiveDocument
	      (vlax-get-acad-object))
layCol(vla-get-Layers actDoc)
); end setq
 (setvar "CMDECHO" 0)
 (if
   (setq dimSet
   (ssget '((0 . "DIMENSION"))))
   (progn
     (setq dimLst
     (mapcar 'vlax-ename->vla-object 
                   (vl-remove-if 'listp 
                    (mapcar 'cadr(ssnamex dimSet))))
    errCount 0
    ); end setq
     (vla-StartUndoMark actDoc)
     (foreach dim dimLst
(setq curLay(vla-get-Layer dim))
(if
  (/= :vlax-true
      (vla-get-Lock(Col_Item_Find layCol curLay)))
  (progn
(vla-put-TextOverride dim "<>")
(vla-put-Color dim 82)
); end progn
  (setq errCount(1+ errCount))
  ); end if
); end foreach
     (if(/= 0 errCount)
(princ
  (strcat "\n"
	  (itoa errCount)" were on locked layer!"))
); end if
     (vla-EndUndoMark actDoc)
     ); end progn
   ); end if
 (setvar "CMDECHO" oldEcho)
 (princ)
)
(defun mip_MTEXT_Unformat ( Mtext / text Str )
 (setq MM Mtext)
 (setq Text "")
  (while (/= Mtext "")
       (cond
         ((wcmatch (strcase (setq Str (substr Mtext 1 2))) "\\[\\{}]")
           (setq Mtext (substr Mtext 3) Text   (strcat Text Str)))
         ((wcmatch (substr Mtext 1 1) "[{}]")(setq Mtext (substr Mtext 2)))
         ((wcmatch (strcase (setq Str (substr Mtext 1 2))) "\\[LO`~]")
   (setq Mtext (substr Mtext 3)))
         ((wcmatch (strcase (substr Mtext 1 2)) "\\[ACFHQTW]")
           (setq Mtext (substr Mtext (+ 2 (vl-string-search ";" Mtext)))))
  ((wcmatch (strcase (substr mtext 1 4)) "\\PQ[CRJD],\\PXQ")  ;;;Add by KPblC
   (setq mtext (substr mtext (+ 2 (vl-string-search ";" mtext))))
   )
         ((wcmatch (strcase (substr Mtext 1 2)) "\\P")
           (if (or
	   (zerop (strlen Text))
	   (= " " (substr Text (strlen Text)))
	   (= " " (substr Mtext 3 1)))
              (setq Mtext (substr Mtext 3))
              (setq Mtext (substr Mtext 3) Text (strcat Text " "))))
  ((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)))))
  (t (setq Text (strcat Text (substr Mtext 1 1)) Mtext (substr Mtext 2)))))
 Text)
(defun dim-get-text-string ( dim / str)
(setq str "")
  (vlax-for item (vla-item (vla-get-blocks
                        (vla-get-activedocument (vlax-get-acad-object))
                      ) ;_ end of vla-get-Blocks
                      (cdr (assoc 2 (entget dim)))
            ) ;_ end of vla-item
    (if (vlax-property-available-p item 'Textstring)
         (setq str (vla-get-textstring item))
      )
    )
(mip_MTEXT_Unformat str)
 )
(princ "\nType Dimo to override and Dimr to restore")

 

  • Vote tăng 1

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Tuanhaxoai    0

Tuanhaxoai
Đã đăng
5 giờ trước, vietduc147258 đã nói:

Bạn thử cái này nha

  


;;https://www.cadtutor.net/forum/topic/6657-copy-dimension-to-text-override/

;;Dim override
(defun c:dimo (/ COPYDIM CURLAY DELSET DIMLST
      DIMSET ERRCOUNT LAYCOL LENT
      NEXTENT OVTEXT *ERROR* ACTDOC
      OLDECHO)
;;; Vladimir Smirnov {Smirnoff} on dwg.ru
 (defun *ERROR* (msg)
   (setvar "CMDECHO" oldEcho)
   ); end of error
 (vl-load-com)
 (setq oldEcho(getvar "CMDECHO")
actDoc(vla-get-ActiveDocument
	      (vlax-get-acad-object))
layCol(vla-get-Layers actDoc)
); end setq
 (setvar "CMDECHO" 0)
 (if
   (setq dimSet
   (ssget "_:L" '((0 . "DIMENSION"))))
   (progn
     (setq dimLst
     (mapcar 'vlax-ename->vla-object 
                   (vl-remove-if 'listp 
                    (mapcar 'cadr(ssnamex dimSet))))
    ); end setq
     (vla-StartUndoMark actDoc)
     (foreach dim dimLst
     	(vla-put-TextOverride dim (dim-get-text-string (vlax-vla-object->ename dim)))
(vla-put-Color dim 22)
       )
     (vla-EndUndoMark actDoc)
     ); end progn
   ); end if
 (setvar "CMDECHO" oldEcho)
 (princ)
 ); end of c:dimo

(defun Col_Item_Find (Collection Item / result)
 (if
   (not
     (vl-catch-all-error-p  
(setq result
       (vl-catch-all-apply 'vla-item
	 (list Collection Item))))) 
   result
   ); end if
 ); end of Col_Item_Find
;;; Dim restore
(defun c:dimr (/ COPYDIM CURLAY DELSET DIMLST
      DIMSET ERRCOUNT LAYCOL LENT
      NEXTENT OVTEXT *ERROR* ACTDOC
      OLDECHO)
;;; Vladimir Smirnov {Smirnoff} on dwg.ru
 (defun *ERROR* (msg)
   (setvar "CMDECHO" oldEcho)
   ); end of error

 (vl-load-com)
 (setq oldEcho(getvar "CMDECHO")
actDoc(vla-get-ActiveDocument
	      (vlax-get-acad-object))
layCol(vla-get-Layers actDoc)
); end setq
 (setvar "CMDECHO" 0)
 (if
   (setq dimSet
   (ssget '((0 . "DIMENSION"))))
   (progn
     (setq dimLst
     (mapcar 'vlax-ename->vla-object 
                   (vl-remove-if 'listp 
                    (mapcar 'cadr(ssnamex dimSet))))
    errCount 0
    ); end setq
     (vla-StartUndoMark actDoc)
     (foreach dim dimLst
(setq curLay(vla-get-Layer dim))
(if
  (/= :vlax-true
      (vla-get-Lock(Col_Item_Find layCol curLay)))
  (progn
(vla-put-TextOverride dim "<>")
(vla-put-Color dim 82)
); end progn
  (setq errCount(1+ errCount))
  ); end if
); end foreach
     (if(/= 0 errCount)
(princ
  (strcat "\n"
	  (itoa errCount)" were on locked layer!"))
); end if
     (vla-EndUndoMark actDoc)
     ); end progn
   ); end if
 (setvar "CMDECHO" oldEcho)
 (princ)
)
(defun mip_MTEXT_Unformat ( Mtext / text Str )
 (setq MM Mtext)
 (setq Text "")
  (while (/= Mtext "")
       (cond
         ((wcmatch (strcase (setq Str (substr Mtext 1 2))) "\\[\\{}]")
           (setq Mtext (substr Mtext 3) Text   (strcat Text Str)))
         ((wcmatch (substr Mtext 1 1) "[{}]")(setq Mtext (substr Mtext 2)))
         ((wcmatch (strcase (setq Str (substr Mtext 1 2))) "\\[LO`~]")
   (setq Mtext (substr Mtext 3)))
         ((wcmatch (strcase (substr Mtext 1 2)) "\\[ACFHQTW]")
           (setq Mtext (substr Mtext (+ 2 (vl-string-search ";" Mtext)))))
  ((wcmatch (strcase (substr mtext 1 4)) "\\PQ[CRJD],\\PXQ")  ;;;Add by KPblC
   (setq mtext (substr mtext (+ 2 (vl-string-search ";" mtext))))
   )
         ((wcmatch (strcase (substr Mtext 1 2)) "\\P")
           (if (or
	   (zerop (strlen Text))
	   (= " " (substr Text (strlen Text)))
	   (= " " (substr Mtext 3 1)))
              (setq Mtext (substr Mtext 3))
              (setq Mtext (substr Mtext 3) Text (strcat Text " "))))
  ((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)))))
  (t (setq Text (strcat Text (substr Mtext 1 1)) Mtext (substr Mtext 2)))))
 Text)
(defun dim-get-text-string ( dim / str)
(setq str "")
  (vlax-for item (vla-item (vla-get-blocks
                        (vla-get-activedocument (vlax-get-acad-object))
                      ) ;_ end of vla-get-Blocks
                      (cdr (assoc 2 (entget dim)))
            ) ;_ end of vla-item
    (if (vlax-property-available-p item 'Textstring)
         (setq str (vla-get-textstring item))
      )
    )
(mip_MTEXT_Unformat str)
 )
(princ "\nType Dimo to override and Dimr to restore")

 

Cảm ơn anh.. List hoạt động tốt ạ

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay
Đăng nhập để thực hiện theo  
Người theo dõi 0
Về Đầu Trang AutoLisp
×