Tuanhaxoai 0 Báo cáo bài đăng Đã đăng Tháng 9 6, 2022 Anh chị nào trong nhóm có list fakedim em xin với ạ... Tìm trong diễn dàn thì không còn link để tải ạ 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 Báo cáo bài đăng Đã đăng Tháng 9 6, 2022 http://www.cadviet.vn/caddata/?act=download47#http://www.cadviet.com/upfiles/fakedim.vlx 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 Báo cáo bài đăng Đã đăng Tháng 9 7, 2022 em cảm ơn anh đã đã phản hồi ạ... link trên bị die mất rồi ạ.. 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 Báo cáo bài đăng Đã đăng Tháng 9 8, 2022 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 Báo cáo bài đăng Đã đăng Tháng 9 8, 2022 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") 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 Báo cáo bài đăng Đã đăng Tháng 9 8, 2022 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