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

Nhờ sữa lisp xuất chiều dài pline ra text

Bởi vanhuyou , trong AutoLisp

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

vanhuyou    25

vanhuyou
Đã đăng

Chào các bác, em có tìm được lisp xuất chiều dài pline ra text field, nhờ các bác giúp em sữa lại cho phù hợp công việc của em:

 - Chiều dài chỉ lấy số nguyên và làm tròn lên 10

 - Text xuất ra có định dạng L=xxxx

 - Chiều dài của text theo chiều cao text dim mặc định

Cám ơn các bác.

MIDLEN.lsp

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

Doan Nguyen Van    489

Doan Nguyen Van
Đã đăng
15 giờ trước, vanhuyou đã nói:

Chào các bác, em có tìm được lisp xuất chiều dài pline ra text field, nhờ các bác giúp em sữa lại cho phù hợp công việc của em:

 - Chiều dài chỉ lấy số nguyên và làm tròn lên 10

 - Text xuất ra có định dạng L=xxxx

 - Chiều dài của text theo chiều cao text dim mặc định

Cám ơn các bác.

MIDLEN.lsp

Thay vì sửa 1 lisp dài dằng dặc thế này, có khi viết lsp mới còn nhanh hơn bạn ạ

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

vanhuyou    25

vanhuyou
Đã đăng
1 giờ} trướ}c, Doan Nguyen Van đã nói:

Thay vì sửa 1 lisp dài dằng dặc thế này, có khi viết lsp mới còn nhanh hơn bạn ạ

Bạn ơi, có thể giúp mình đc không

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

thiep    365

thiep
Đã đăng
Vào lúc 27/6/2021 tại 19:33, vanhuyou đã nói:

Chào các bác, em có tìm được lisp xuất chiều dài pline ra text field, nhờ các bác giúp em sữa lại cho phù hợp công việc của em:

 - Chiều dài chỉ lấy số nguyên và làm tròn lên 10

 - Text xuất ra có định dạng L=xxxx

 - Chiều dài của text theo chiều cao text dim mặc định 

Cám ơn các bác.

MIDLEN.lsp

Có thể giúp bạn, cũng không khó, nhưng câu thứ 3 màu đỏ, chưa hiểu???

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

vanhuyou    25

vanhuyou
Đã đăng
14 giờ trước, thiep đã nói:

Có thể giúp bạn, cũng không khó, nhưng câu thứ 3 màu đỏ, chưa hiểu???

ý của em là ví dụ dim style hiện hành chiều cao text là 2 và dim scale là 100 thì lúc đó text xuất ra có chiều cao là = 2*100

  • Vote giảm 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

vanhuyou    25

vanhuyou
Đã đăng
18 giờ trước, DungNguyen685 đã nói:

Tham khảo code của Lee Mac. làm tròn field thì mình không biết làm :((

Untitled Project.gif

lisp mình up lên là của leemac mà sao không giống nhỉ

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

DungNguyen685    40

DungNguyen685
Đã đăng
1 giờ} trướ}c, vanhuyou đã nói:

lisp mình up lên là của leemac mà sao không giống nhỉ 

;;----------------------=={ Length at Midpoint }==----------------------;;
;;                                                                      ;;
;;  This program prompts the user for a selection of objects to be      ;;
;;  labelled and proceeds to generate an MText object located at        ;;
;;  the midpoint of each object displaying a Field Expression           ;;
;;  referencing the length of the object.                               ;;
;;                                                                      ;;
;;  The program is compatible for use with Arcs, Circles, Lines,        ;;
;;  LWPolylines, 2D & 3D Polylines, and under all UCS & View settings.  ;;
;;                                                                      ;;
;;  The program will generate MText objects positioned directly over    ;;
;;  the midpoint of each object, and aligned with the object whilst     ;;
;;  preserving text readability. The MText will have a background mask  ;;
;;  enabled and will use the active Text Style and Text Height settings ;;
;;  at the time of running the program.                                 ;;
;;----------------------------------------------------------------------;;
;;  Author:  Lee Mac, Copyright © 2013  -  www.lee-mac.com              ;;
;;----------------------------------------------------------------------;;
;;  Version 1.0    -    2013-11-12                                      ;;
;;                                                                      ;;
;;  - First release.                                                    ;;
;;----------------------------------------------------------------------;;
;;  Version 1.1    -    2016-01-16                                      ;;
;;                                                                      ;;
;;  - Modified LM:objectid function to account for 64-bit AutoCAD 2008. ;;
;;----------------------------------------------------------------------;;

(defun c:midlen ( / *error* ent fmt idx ins ocs par sel spc txt typ uxa )

    (setq fmt "%lu6") ;; Field Formatting
    (setq pr "%pr0") ;;  Precision

	(setq 	sca1 (getvar "DIMTXT"))
	(setq 	sca2 (getvar "DIMSCALE"))
	(setq sca3 (* sca1 sca2))
	(setvar "textsize" sca3)

    (defun *error* ( msg )
        (LM:endundo (LM:acdoc))
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\nError: " msg))
        )
        (princ)
    )
    
    (if
        (setq sel
            (ssget
                (list
                   '(0 . "ARC,CIRCLE,LINE,*POLYLINE")
                   '(-4 . "<NOT")
                       '(-4 . "<AND")
                           '(0 . "POLYLINE")
                           '(-4 . "&")
                           '(70 . 80)
                       '(-4 . "AND>")
                   '(-4 . "NOT>")
                    (if (= 1 (getvar 'cvport))
                        (cons 410 (getvar 'ctab))
                       '(410 . "Model")
                    )
                )
            )
        )
        (progn
            (setq spc
                (vlax-get-property (LM:acdoc)
                    (if (= 1 (getvar 'cvport))
                        'paperspace
                        'modelspace
                    )
                )
            )
            (setq ocs (trans '(0.0 0.0 1.0) 1 0 t)
                  uxa (angle '(0.0 0.0) (trans (getvar 'ucsxdir) 0 ocs t))
            )
            (LM:startundo (LM:acdoc))
            (repeat (setq idx (sslength sel))
                (setq ent (ssname sel (setq idx (1- idx)))
                      par (vlax-curve-getparamatdist ent (/ (vlax-curve-getdistatparam ent (vlax-curve-getendparam ent)) 2.0))
                      ins (vlax-curve-getpointatparam ent par)
                      typ (cdr (assoc 0 (entget ent)))
                )
                (setq txt
                    (vlax-invoke spc 'addmtext ins 0.0
                        (strcat "L="
                            "%<\\AcObjProp Object(%<\\_ObjId " (LM:objectid (vlax-ename->vla-object ent)) ">%)."
                            (cond
                                (   (= "CIRCLE" typ) "Circumference")
                                (   (= "ARC"    typ) "ArcLength")
                                (   "Length"   )
                            )
                            " \\f \"" fmt pr "\">%"
                        )
                    )
                )
                (vla-put-backgroundfill  txt :vlax-true)
                (vla-put-attachmentpoint txt acattachmentpointmiddlecenter)
                (vla-put-insertionpoint  txt (vlax-3D-point ins))
                (vla-put-rotation txt (LM:readable (- (angle '(0.0 0.0 0.0) (trans (vlax-curve-getfirstderiv ent par) 0 ocs t)) uxa)))
            )
            (LM:endundo (LM:acdoc))
        )
    )
    (princ)
)

;; Readable  -  Lee Mac
;; Returns an angle corrected for text readability.

(defun LM:readable ( a )
    (   (lambda ( a )
            (if (and (< (* pi 0.5) a) (<= a (* pi 1.5)))
                (LM:readable (+ a pi))
                a
            )
        )
        (rem (+ a pi pi) (+ pi pi))
    )
)

;; ObjectID  -  Lee Mac
;; Returns a string containing the ObjectID of a supplied VLA-Object
;; Compatible with 32-bit & 64-bit systems

(defun LM:objectid ( obj )
    (eval
        (list 'defun 'LM:objectid '( obj )
            (if (wcmatch (getenv "PROCESSOR_ARCHITECTURE") "*64*")
                (if (vlax-method-applicable-p (vla-get-utility (LM:acdoc)) 'getobjectidstring)
                    (list 'vla-getobjectidstring (vla-get-utility (LM:acdoc)) 'obj ':vlax-false)
                   '(LM:ename->objectid (vlax-vla-object->ename obj))
                )
               '(itoa (vla-get-objectid obj))
            )
        )
    )
    (LM:objectid obj)
)

;; Entity Name to ObjectID  -  Lee Mac
;; Returns the 32-bit or 64-bit ObjectID for a supplied entity name

(defun LM:ename->objectid ( ent )
    (LM:hex->decstr
        (setq ent (vl-string-right-trim ">" (vl-prin1-to-string ent))
              ent (substr ent (+ (vl-string-position 58 ent) 3))
        )
    )
)

;; Hex to Decimal String  -  Lee Mac
;; Returns the decimal representation of a supplied hexadecimal string

(defun LM:hex->decstr ( hex / foo bar )
    (defun foo ( lst rtn )
        (if lst
            (foo (cdr lst) (bar (- (car lst) (if (< 57 (car lst)) 55 48)) rtn))
            (apply 'strcat (mapcar 'itoa (reverse rtn)))
        )
    )
    (defun bar ( int lst )
        (if lst
            (if (or (< 0 (setq int (+ (* 16 (car lst)) int))) (cdr lst))
                (cons (rem int 10) (bar (/ int 10) (cdr lst)))
            )
            (bar int '(0))
        )
    )
    (foo (vl-string->list (strcase hex)) nil)
)

;; Start Undo  -  Lee Mac
;; Opens an Undo Group.

(defun LM:startundo ( doc )
    (LM:endundo doc)
    (vla-startundomark doc)
)

;; End Undo  -  Lee Mac
;; Closes an Undo Group.

(defun LM:endundo ( doc )
    (while (= 8 (logand 8 (getvar 'undoctl)))
        (vla-endundomark doc)
    )
)

;; Active Document  -  Lee Mac
;; Returns the VLA Active Document Object

(defun LM:acdoc nil
    (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
    (LM:acdoc)
)

(vl-load-com)
(princ
    (strcat
        "\n:: MidLen.lsp | Version 1.1 | \\U+00A9 Lee Mac "
        (menucmd "m=$(edtime,0,yyyy)")
        " www.lee-mac.com ::"
        "\n:: Type \"midlen\" to Invoke ::"
    )
)
(princ)

;;----------------------------------------------------------------------;;
;;                             End of File                              ;;
;;----------------------------------------------------------------------;;

Mình giúp bạn đến đây nhé! test thử xem.

  • Like 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

thiep    365

thiep
Đã đăng

Dựa theo lisp MIDLEN.lsp của LEEMAC, Thiep ra lisp LENGFIELD.lsp phù hợp với ý của bạn

Nhớ là cách chọn đối tượng là kiểu Fence nhe bạn, mục đích của mình là đối tượng polyline nào "dính" hàng rào trước thì lisp sẽ tạo ra 1 text gắn field trước, như vậy sẽ pick điểm chèn text cho phù hợp theo trật tự. 

;;-------------------=={ Length *POLYLINE _ field }==-------------------;;
;;                                                                      ;;
;;  This program prompts the user for a selection of objects to be      ;;
;;  labelled and proceeds to generate an MText object located at        ;;
;;  the midpoint of each object displaying a Field Expression           ;;
;;  referencing the length of the object.                               ;;
;;                                                                      ;;
;;  The program is compatible for use with *Polylines, and under        ;;
;;  all UCS & View settings.                                            ;;
;;  The MText will have a background mask                               ;;
;;  enabled and will use the active Text Style and Text Height settings ;;
;;  at the time of running the program.                                 ;;
;;----------------------------------------------------------------------;;
;;  Author: Trân Thiêp base lisp midlen.lsp by Lee Mac, Copyright © 2013  -  www.lee-mac.com              ;;
;;----------------------------------------------------------------------;;
;;  - Modified LM:objectid function to account for 64-bit AutoCAD 2008. ;;
;;----------------------------------------------------------------------;;

(defun c:lengfield (/ *error* ent fmt idx ins ocs par sel spc txt typ uxa)
    (setvar "textsize" (getvar "DIMTXT"))
    (defun *error* (msg)
	(LM:endundo (LM:acdoc))
	(if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
	    (princ (strcat "\nError: " msg))
	)
	(princ)
    )
    (if	(setq sel (ssget "F"
			 (acet-ui-fence-select)
			 (list '(0 . "*POLYLINE")
			       '(-4 . "<NOT")
			       '(-4 . "<AND")
			       '(0 . "POLYLINE")
			       '(-4 . "&")
			       '(70 . 80)
			       '(-4 . "AND>")
			       '(-4 . "NOT>")
			       (if (= 1 (getvar 'cvport))
				   (cons 410 (getvar 'ctab))
				   '(410 . "Model")
			       )
			 )
		  )
	)
	(progn (setq spc (vlax-get-property (LM:acdoc)
					    (if	(= 1 (getvar 'cvport))
						'paperspace
						'modelspace
					    )
			 )
	       )
	       (setq ocs (trans '(0.0 0.0 1.0) 1 0 t)
		     uxa (angle '(0.0 0.0) (trans (getvar 'ucsxdir) 0 ocs t))
	       )
	       (LM:startundo (LM:acdoc))
	       (repeat (setq idx (sslength sel))
		   (setq ent (ssname sel (setq idx (1- idx)))
			 par (vlax-curve-getparamatdist
				 ent
				 (/ (vlax-curve-getdistatparam ent (vlax-curve-getendparam ent)) 2.0)
			     )
			 ins (vlax-curve-getpointatparam ent par)
			 typ (cdr (assoc 0 (entget ent)))
		   )
		   (setq txt (vlax-invoke spc
					  'addmtext
					  ins
					  0.0
					  (strcat "L="
						  "%<\\AcObjProp Object(%<\\_ObjId "
						  (LM:objectid (vlax-ename->vla-object ent))
						  ">%).Length \\f \"%lu2%pr0%ps[,0]%ct8[0.1]\">%"
					  )
			     )
		   )
		   (vla-put-backgroundfill txt :vlax-true)
		   (vla-put-attachmentpoint txt acattachmentpointmiddlecenter)
		   (vla-put-insertionpoint
		       txt
		       (vlax-3D-point (getpoint "\pick a point for inserttext_field"))
		   )
	       )
	       (LM:endundo (LM:acdoc))
	)
    )
    (princ)
)

;; Readable  -  Lee Mac
;; Returns an angle corrected for text readability.

(defun LM:readable ( a )
    (   (lambda ( a )
            (if (and (< (* pi 0.5) a) (<= a (* pi 1.5)))
                (LM:readable (+ a pi))
                a
            )
        )
        (rem (+ a pi pi) (+ pi pi))
    )
)

;; ObjectID  -  Lee Mac
;; Returns a string containing the ObjectID of a supplied VLA-Object
;; Compatible with 32-bit & 64-bit systems

(defun LM:objectid ( obj )
    (eval
        (list 'defun 'LM:objectid '( obj )
            (if (wcmatch (getenv "PROCESSOR_ARCHITECTURE") "*64*")
                (if (vlax-method-applicable-p (vla-get-utility (LM:acdoc)) 'getobjectidstring)
                    (list 'vla-getobjectidstring (vla-get-utility (LM:acdoc)) 'obj ':vlax-false)
                   '(LM:ename->objectid (vlax-vla-object->ename obj))
                )
               '(itoa (vla-get-objectid obj))
            )
        )
    )
    (LM:objectid obj)
)

;; Entity Name to ObjectID  -  Lee Mac
;; Returns the 32-bit or 64-bit ObjectID for a supplied entity name

(defun LM:ename->objectid ( ent )
    (LM:hex->decstr
        (setq ent (vl-string-right-trim ">" (vl-prin1-to-string ent))
              ent (substr ent (+ (vl-string-position 58 ent) 3))
        )
    )
)

;; Hex to Decimal String  -  Lee Mac
;; Returns the decimal representation of a supplied hexadecimal string

(defun LM:hex->decstr ( hex / foo bar )
    (defun foo ( lst rtn )
        (if lst
            (foo (cdr lst) (bar (- (car lst) (if (< 57 (car lst)) 55 48)) rtn))
            (apply 'strcat (mapcar 'itoa (reverse rtn)))
        )
    )
    (defun bar ( int lst )
        (if lst
            (if (or (< 0 (setq int (+ (* 16 (car lst)) int))) (cdr lst))
                (cons (rem int 10) (bar (/ int 10) (cdr lst)))
            )
            (bar int '(0))
        )
    )
    (foo (vl-string->list (strcase hex)) nil)
)

;; Start Undo  -  Lee Mac
;; Opens an Undo Group.

(defun LM:startundo ( doc )
    (LM:endundo doc)
    (vla-startundomark doc)
)

;; End Undo  -  Lee Mac
;; Closes an Undo Group.

(defun LM:endundo ( doc )
    (while (= 8 (logand 8 (getvar 'undoctl)))
        (vla-endundomark doc)
    )
)

;; Active Document  -  Lee Mac
;; Returns the VLA Active Document Object

(defun LM:acdoc nil
    (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
    (LM:acdoc)
)

(vl-load-com)
(princ
    (strcat "\n:: Lengfield.lsp | by TranThiep | "
	    (menucmd "m=$(edtime,0,yyyy)")
	    ", based lisp midlen.lsp \\U+00A9 Lee Mac "
	    "\n:: Type \"lengfield\" to Invoke ::"
    )
)
(princ)

;;----------------------------------------------------------------------;;
;;                             End of File                              ;;
;;----------------------------------------------------------------------;;

Thân ái, chúc bạn thành công. TranThiep tel:0918841230

  • Like 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

vanhuyou    25

vanhuyou
Đã đăng

Em xin cám ơn 2 bác

DungNguyen685 và thiep đã giúp đỡ.

49 phút trước, thiep đã nói:

Dựa theo lisp MIDLEN.lsp của LEEMAC, Thiep ra lisp LENGFIELD.lsp phù hợp với ý của bạn

Nhớ là cách chọn đối tượng là kiểu Fence nhe bạn, mục đích của mình là đối tượng polyline nào "dính" hàng rào trước thì lisp sẽ tạo ra 1 text gắn field trước, như vậy sẽ pick điểm chèn text cho phù hợp theo trật tự. 


;;-------------------=={ Length *POLYLINE _ field }==-------------------;;
;                                                                      ;;
;  This program prompts the user for a selection of objects to be      ;;
;  labelled and proceeds to generate an MText object located at        ;;
;  the midpoint of each object displaying a Field Expression           ;;
;  referencing the length of the object.                               ;;
;                                                                      ;;
;  The program is compatible for use with *Polylines, and under        ;;
;  all UCS & View settings.                                            ;;
;  The MText will have a background mask                               ;;
;  enabled and will use the active Text Style and Text Height settings ;;
;  at the time of running the program.                                 ;;
;----------------------------------------------------------------------;;
;  Author: Trân Thiêp base lisp midlen.lsp by Lee Mac, Copyright © 2013  -  www.lee-mac.com              ;;
;----------------------------------------------------------------------;;
;  - Modified LM:objectid function to account for 64-bit AutoCAD 2008. ;;
;----------------------------------------------------------------------;;

(defun c:lengfield (/ *error* ent fmt idx ins ocs par sel spc txt typ uxa)
    (setvar "textsize" (getvar "DIMTXT"))
    (defun *error* (msg)
	(LM:endundo (LM:acdoc))
	(if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
	    (princ (strcat "\nError: " msg))
	)
	(princ)
    )
    (if	(setq sel (ssget "F"
			 (acet-ui-fence-select)
			 (list '(0 . "*POLYLINE")
			       '(-4 . "<NOT")
			       '(-4 . "<AND")
			       '(0 . "POLYLINE")
			       '(-4 . "&")
			       '(70 . 80)
			       '(-4 . "AND>")
			       '(-4 . "NOT>")
			       (if (= 1 (getvar 'cvport))
				   (cons 410 (getvar 'ctab))
				   '(410 . "Model")
			       )
			 )
		  )
	)
	(progn (setq spc (vlax-get-property (LM:acdoc)
					    (if	(= 1 (getvar 'cvport))
						'paperspace
						'modelspace
					    )
			 )
	       )
	       (setq ocs (trans '(0.0 0.0 1.0) 1 0 t)
		     uxa (angle '(0.0 0.0) (trans (getvar 'ucsxdir) 0 ocs t))
	       )
	       (LM:startundo (LM:acdoc))
	       (repeat (setq idx (sslength sel))
		   (setq ent (ssname sel (setq idx (1- idx)))
			 par (vlax-curve-getparamatdist
				 ent
				 (/ (vlax-curve-getdistatparam ent (vlax-curve-getendparam ent)) 2.0)
			     )
			 ins (vlax-curve-getpointatparam ent par)
			 typ (cdr (assoc 0 (entget ent)))
		   )
		   (setq txt (vlax-invoke spc
					  'addmtext
					  ins
					  0.0
					  (strcat "L="
						  "%<\\AcObjProp Object(%<\\_ObjId "
						  (LM:objectid (vlax-ename->vla-object ent))
						  ">%).Length \\f \"%lu2%pr0%ps[,0]%ct8[0.1]\">%"
					  )
			     )
		   )
		   (vla-put-backgroundfill txt :vlax-true)
		   (vla-put-attachmentpoint txt acattachmentpointmiddlecenter)
		   (vla-put-insertionpoint
		       txt
		       (vlax-3D-point (getpoint "\pick a point for inserttext_field"))
		   )
	       )
	       (LM:endundo (LM:acdoc))
	)
    )
    (princ)
)

;; Readable  -  Lee Mac
; Returns an angle corrected for text readability.

(defun LM:readable ( a )
    (   (lambda ( a )
            (if (and (< (* pi 0.5) a) (<= a (* pi 1.5)))
                (LM:readable (+ a pi))
                a
            )
        )
        (rem (+ a pi pi) (+ pi pi))
    )
)

;; ObjectID  -  Lee Mac
; Returns a string containing the ObjectID of a supplied VLA-Object
; Compatible with 32-bit & 64-bit systems

(defun LM:objectid ( obj )
    (eval
        (list 'defun 'LM:objectid '( obj )
            (if (wcmatch (getenv "PROCESSOR_ARCHITECTURE") "*64*")
                (if (vlax-method-applicable-p (vla-get-utility (LM:acdoc)) 'getobjectidstring)
                    (list 'vla-getobjectidstring (vla-get-utility (LM:acdoc)) 'obj ':vlax-false)
                   '(LM:ename->objectid (vlax-vla-object->ename obj))
                )
               '(itoa (vla-get-objectid obj))
            )
        )
    )
    (LM:objectid obj)
)

;; Entity Name to ObjectID  -  Lee Mac
; Returns the 32-bit or 64-bit ObjectID for a supplied entity name

(defun LM:ename->objectid ( ent )
    (LM:hex->decstr
        (setq ent (vl-string-right-trim ">" (vl-prin1-to-string ent))
              ent (substr ent (+ (vl-string-position 58 ent) 3))
        )
    )
)

;; Hex to Decimal String  -  Lee Mac
; Returns the decimal representation of a supplied hexadecimal string

(defun LM:hex->decstr ( hex / foo bar )
    (defun foo ( lst rtn )
        (if lst
            (foo (cdr lst) (bar (- (car lst) (if (< 57 (car lst)) 55 48)) rtn))
            (apply 'strcat (mapcar 'itoa (reverse rtn)))
        )
    )
    (defun bar ( int lst )
        (if lst
            (if (or (< 0 (setq int (+ (* 16 (car lst)) int))) (cdr lst))
                (cons (rem int 10) (bar (/ int 10) (cdr lst)))
            )
            (bar int '(0))
        )
    )
    (foo (vl-string->list (strcase hex)) nil)
)

;; Start Undo  -  Lee Mac
; Opens an Undo Group.

(defun LM:startundo ( doc )
    (LM:endundo doc)
    (vla-startundomark doc)
)

;; End Undo  -  Lee Mac
; Closes an Undo Group.

(defun LM:endundo ( doc )
    (while (= 8 (logand 8 (getvar 'undoctl)))
        (vla-endundomark doc)
    )
)

;; Active Document  -  Lee Mac
; Returns the VLA Active Document Object

(defun LM:acdoc nil
    (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
    (LM:acdoc)
)

(vl-load-com)
(princ
    (strcat "\n:: Lengfield.lsp | by TranThiep | "
	    (menucmd "m=$(edtime,0,yyyy)")
	    ", based lisp midlen.lsp \\U+00A9 Lee Mac "
	    "\n:: Type \"lengfield\" to Invoke ::"
    )
)
(princ)

;;----------------------------------------------------------------------;;
;                             End of File                              ;;
;----------------------------------------------------------------------;;

Thân ái, chúc bạn thành công. TranThiep tel:0918841230

Cám ơn bác nhiều.

  • Vote giảm 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

vanhuyou    25

vanhuyou
Đã đăng
17 giờ trước, DungNguyen685 đã nói: 

;;----------------------=={ Length at Midpoint }==----------------------;;
;                                                                      ;;
;  This program prompts the user for a selection of objects to be      ;;
;  labelled and proceeds to generate an MText object located at        ;;
;  the midpoint of each object displaying a Field Expression           ;;
;  referencing the length of the object.                               ;;
;                                                                      ;;
;  The program is compatible for use with Arcs, Circles, Lines,        ;;
;  LWPolylines, 2D & 3D Polylines, and under all UCS & View settings.  ;;
;                                                                      ;;
;  The program will generate MText objects positioned directly over    ;;
;  the midpoint of each object, and aligned with the object whilst     ;;
;  preserving text readability. The MText will have a background mask  ;;
;  enabled and will use the active Text Style and Text Height settings ;;
;  at the time of running the program.                                 ;;
;----------------------------------------------------------------------;;
;  Author:  Lee Mac, Copyright © 2013  -  www.lee-mac.com              ;;
;----------------------------------------------------------------------;;
;  Version 1.0    -    2013-11-12                                      ;;
;                                                                      ;;
;  - First release.                                                    ;;
;----------------------------------------------------------------------;;
;  Version 1.1    -    2016-01-16                                      ;;
;                                                                      ;;
;  - Modified LM:objectid function to account for 64-bit AutoCAD 2008. ;;
;----------------------------------------------------------------------;;

(defun c:midlen ( / *error* ent fmt idx ins ocs par sel spc txt typ uxa )

    (setq fmt "%lu6") ;; Field Formatting
    (setq pr "%pr0") ;;  Precision

	(setq 	sca1 (getvar "DIMTXT"))
	(setq 	sca2 (getvar "DIMSCALE"))
	(setq sca3 (* sca1 sca2))
	(setvar "textsize" sca3)

    (defun *error* ( msg )
        (LM:endundo (LM:acdoc))
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\nError: " msg))
        )
        (princ)
    )
    
    (if
        (setq sel
            (ssget
                (list
                   '(0 . "ARC,CIRCLE,LINE,*POLYLINE")
                   '(-4 . "<NOT")
                       '(-4 . "<AND")
                           '(0 . "POLYLINE")
                           '(-4 . "&")
                           '(70 . 80)
                       '(-4 . "AND>")
                   '(-4 . "NOT>")
                    (if (= 1 (getvar 'cvport))
                        (cons 410 (getvar 'ctab))
                       '(410 . "Model")
                    )
                )
            )
        )
        (progn
            (setq spc
                (vlax-get-property (LM:acdoc)
                    (if (= 1 (getvar 'cvport))
                        'paperspace
                        'modelspace
                    )
                )
            )
            (setq ocs (trans '(0.0 0.0 1.0) 1 0 t)
                  uxa (angle '(0.0 0.0) (trans (getvar 'ucsxdir) 0 ocs t))
            )
            (LM:startundo (LM:acdoc))
            (repeat (setq idx (sslength sel))
                (setq ent (ssname sel (setq idx (1- idx)))
                      par (vlax-curve-getparamatdist ent (/ (vlax-curve-getdistatparam ent (vlax-curve-getendparam ent)) 2.0))
                      ins (vlax-curve-getpointatparam ent par)
                      typ (cdr (assoc 0 (entget ent)))
                )
                (setq txt
                    (vlax-invoke spc 'addmtext ins 0.0
                        (strcat "L="
                            "%<\\AcObjProp Object(%<\\_ObjId " (LM:objectid (vlax-ename->vla-object ent)) ">%)."
                            (cond
                                (   (= "CIRCLE" typ) "Circumference")
                                (   (= "ARC"    typ) "ArcLength")
                                (   "Length"   )
                            )
                            " \\f \"" fmt pr "\">%"
                        )
                    )
                )
                (vla-put-backgroundfill  txt :vlax-true)
                (vla-put-attachmentpoint txt acattachmentpointmiddlecenter)
                (vla-put-insertionpoint  txt (vlax-3D-point ins))
                (vla-put-rotation txt (LM:readable (- (angle '(0.0 0.0 0.0) (trans (vlax-curve-getfirstderiv ent par) 0 ocs t)) uxa)))
            )
            (LM:endundo (LM:acdoc))
        )
    )
    (princ)
)

;; Readable  -  Lee Mac
; Returns an angle corrected for text readability.

(defun LM:readable ( a )
    (   (lambda ( a )
            (if (and (< (* pi 0.5) a) (<= a (* pi 1.5)))
                (LM:readable (+ a pi))
                a
            )
        )
        (rem (+ a pi pi) (+ pi pi))
    )
)

;; ObjectID  -  Lee Mac
; Returns a string containing the ObjectID of a supplied VLA-Object
; Compatible with 32-bit & 64-bit systems

(defun LM:objectid ( obj )
    (eval
        (list 'defun 'LM:objectid '( obj )
            (if (wcmatch (getenv "PROCESSOR_ARCHITECTURE") "*64*")
                (if (vlax-method-applicable-p (vla-get-utility (LM:acdoc)) 'getobjectidstring)
                    (list 'vla-getobjectidstring (vla-get-utility (LM:acdoc)) 'obj ':vlax-false)
                   '(LM:ename->objectid (vlax-vla-object->ename obj))
                )
               '(itoa (vla-get-objectid obj))
            )
        )
    )
    (LM:objectid obj)
)

;; Entity Name to ObjectID  -  Lee Mac
; Returns the 32-bit or 64-bit ObjectID for a supplied entity name

(defun LM:ename->objectid ( ent )
    (LM:hex->decstr
        (setq ent (vl-string-right-trim ">" (vl-prin1-to-string ent))
              ent (substr ent (+ (vl-string-position 58 ent) 3))
        )
    )
)

;; Hex to Decimal String  -  Lee Mac
; Returns the decimal representation of a supplied hexadecimal string

(defun LM:hex->decstr ( hex / foo bar )
    (defun foo ( lst rtn )
        (if lst
            (foo (cdr lst) (bar (- (car lst) (if (< 57 (car lst)) 55 48)) rtn))
            (apply 'strcat (mapcar 'itoa (reverse rtn)))
        )
    )
    (defun bar ( int lst )
        (if lst
            (if (or (< 0 (setq int (+ (* 16 (car lst)) int))) (cdr lst))
                (cons (rem int 10) (bar (/ int 10) (cdr lst)))
            )
            (bar int '(0))
        )
    )
    (foo (vl-string->list (strcase hex)) nil)
)

;; Start Undo  -  Lee Mac
; Opens an Undo Group.

(defun LM:startundo ( doc )
    (LM:endundo doc)
    (vla-startundomark doc)
)

;; End Undo  -  Lee Mac
; Closes an Undo Group.

(defun LM:endundo ( doc )
    (while (= 8 (logand 8 (getvar 'undoctl)))
        (vla-endundomark doc)
    )
)

;; Active Document  -  Lee Mac
; Returns the VLA Active Document Object

(defun LM:acdoc nil
    (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
    (LM:acdoc)
)

(vl-load-com)
(princ
    (strcat
        "\n:: MidLen.lsp | Version 1.1 | \\U+00A9 Lee Mac "
        (menucmd "m=$(edtime,0,yyyy)")
        " www.lee-mac.com ::"
        "\n:: Type \"midlen\" to Invoke ::"
    )
)
(princ)

;;----------------------------------------------------------------------;;
;                             End of File                              ;;
;----------------------------------------------------------------------;;

Mình giúp bạn đến đây nhé! test thử xem.

Bác nào có thể giúp em làm tròn số lên 10 được không, giúp em với.

  • Vote giảm 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

NTHAHT    78

NTHAHT
Đã đăng

Bạn thay dòng (ở đầu lisp MIDLEN):

(setq fmt "%lu6") thành: (setq fmt "%lu2%pr0%ps[L = ,0]%ct8[0.1]")

Rồi test thử xem sao.

  • Like 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

thiep    365

thiep
Đã đăng
12 giờ trước, vanhuyou đã nói:

Bác nào có thể giúp em làm tròn số lên 10 được không, giúp em với.

Ơ, đã giúp rồi còn gì? Bạn chạy trên autoCad đời nào? Bạn đã chạy lisp và kết quả như thế nào? chụp hình gửi lên xem?

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

DungNguyen685    40

DungNguyen685
Đã đăng
Vào lúc 4/7/2021 tại 08:55, vanhuyou đã nói:

Bác nào có thể giúp em làm tròn số lên 10 được không, giúp em với. 

;;----------------------=={ Length at Midpoint }==----------------------;;
;;                                                                      ;;
;;  This program prompts the user for a selection of objects to be      ;;
;;  labelled and proceeds to generate an MText object located at        ;;
;;  the midpoint of each object displaying a Field Expression           ;;
;;  referencing the length of the object.                               ;;
;;                                                                      ;;
;;  The program is compatible for use with Arcs, Circles, Lines,        ;;
;;  LWPolylines, 2D & 3D Polylines, and under all UCS & View settings.  ;;
;;                                                                      ;;
;;  The program will generate MText objects positioned directly over    ;;
;;  the midpoint of each object, and aligned with the object whilst     ;;
;;  preserving text readability. The MText will have a background mask  ;;
;;  enabled and will use the active Text Style and Text Height settings ;;
;;  at the time of running the program.                                 ;;
;;----------------------------------------------------------------------;;
;;  Author:  Lee Mac, Copyright © 2013  -  www.lee-mac.com              ;;
;;----------------------------------------------------------------------;;
;;  Version 1.0    -    2013-11-12                                      ;;
;;                                                                      ;;
;;  - First release.                                                    ;;
;;----------------------------------------------------------------------;;
;;  Version 1.1    -    2016-01-16                                      ;;
;;                                                                      ;;
;;  - Modified LM:objectid function to account for 64-bit AutoCAD 2008. ;;
;;----------------------------------------------------------------------;;

(defun c:midlen ( / *error* ent fmt idx ins ocs par sel spc txt typ uxa )

    (setq fmt "%lu6") ;; Field Formatting
    (setq pr "%pr0") ;;  Precision
    (setq ps "%ps[,0]") ;;  
    (setq ct "%ct8[0.1]") ;;  
	
	(setq 	sca1 (getvar "DIMTXT"))
	(setq 	sca2 (getvar "DIMSCALE"))
	(setq sca3 (* sca1 sca2))
	(setvar "textsize" sca3)

    (defun *error* ( msg )
        (LM:endundo (LM:acdoc))
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\nError: " msg))
        )
        (princ)
    )
    
    (if
        (setq sel
            (ssget
                (list
                   '(0 . "ARC,CIRCLE,LINE,*POLYLINE")
                   '(-4 . "<NOT")
                       '(-4 . "<AND")
                           '(0 . "POLYLINE")
                           '(-4 . "&")
                           '(70 . 80)
                       '(-4 . "AND>")
                   '(-4 . "NOT>")
                    (if (= 1 (getvar 'cvport))
                        (cons 410 (getvar 'ctab))
                       '(410 . "Model")
                    )
                )
            )
        )
        (progn
            (setq spc
                (vlax-get-property (LM:acdoc)
                    (if (= 1 (getvar 'cvport))
                        'paperspace
                        'modelspace
                    )
                )
            )
            (setq ocs (trans '(0.0 0.0 1.0) 1 0 t)
                  uxa (angle '(0.0 0.0) (trans (getvar 'ucsxdir) 0 ocs t))
            )
            (LM:startundo (LM:acdoc))
            (repeat (setq idx (sslength sel))
                (setq ent (ssname sel (setq idx (1- idx)))
                      par (vlax-curve-getparamatdist ent (/ (vlax-curve-getdistatparam ent (vlax-curve-getendparam ent)) 2.0))
                      ins (vlax-curve-getpointatparam ent par)
                      typ (cdr (assoc 0 (entget ent)))
                )
                (setq txt
                    (vlax-invoke spc 'addmtext ins 0.0
                        (strcat "L="
                            "%<\\AcObjProp Object(%<\\_ObjId " (LM:objectid (vlax-ename->vla-object ent)) ">%)."
                            (cond
                                (   (= "CIRCLE" typ) "Circumference")
                                (   (= "ARC"    typ) "ArcLength")
                                (   "Length"   )
                            )
                            " \\f \"  " fmt pr ps ct " \">%"
                        )
                    )
                )
                (vla-put-backgroundfill  txt :vlax-true)
                (vla-put-attachmentpoint txt acattachmentpointmiddlecenter)
                (vla-put-insertionpoint  txt (vlax-3D-point ins))
                (vla-put-rotation txt (LM:readable (- (angle '(0.0 0.0 0.0) (trans (vlax-curve-getfirstderiv ent par) 0 ocs t)) uxa)))
            )
            (LM:endundo (LM:acdoc))
        )
    )
    (princ)
)

;; Readable  -  Lee Mac
;; Returns an angle corrected for text readability.

(defun LM:readable ( a )
    (   (lambda ( a )
            (if (and (< (* pi 0.5) a) (<= a (* pi 1.5)))
                (LM:readable (+ a pi))
                a
            )
        )
        (rem (+ a pi pi) (+ pi pi))
    )
)

;; ObjectID  -  Lee Mac
;; Returns a string containing the ObjectID of a supplied VLA-Object
;; Compatible with 32-bit & 64-bit systems

(defun LM:objectid ( obj )
    (eval
        (list 'defun 'LM:objectid '( obj )
            (if (wcmatch (getenv "PROCESSOR_ARCHITECTURE") "*64*")
                (if (vlax-method-applicable-p (vla-get-utility (LM:acdoc)) 'getobjectidstring)
                    (list 'vla-getobjectidstring (vla-get-utility (LM:acdoc)) 'obj ':vlax-false)
                   '(LM:ename->objectid (vlax-vla-object->ename obj))
                )
               '(itoa (vla-get-objectid obj))
            )
        )
    )
    (LM:objectid obj)
)

;; Entity Name to ObjectID  -  Lee Mac
;; Returns the 32-bit or 64-bit ObjectID for a supplied entity name

(defun LM:ename->objectid ( ent )
    (LM:hex->decstr
        (setq ent (vl-string-right-trim ">" (vl-prin1-to-string ent))
              ent (substr ent (+ (vl-string-position 58 ent) 3))
        )
    )
)

;; Hex to Decimal String  -  Lee Mac
;; Returns the decimal representation of a supplied hexadecimal string

(defun LM:hex->decstr ( hex / foo bar )
    (defun foo ( lst rtn )
        (if lst
            (foo (cdr lst) (bar (- (car lst) (if (< 57 (car lst)) 55 48)) rtn))
            (apply 'strcat (mapcar 'itoa (reverse rtn)))
        )
    )
    (defun bar ( int lst )
        (if lst
            (if (or (< 0 (setq int (+ (* 16 (car lst)) int))) (cdr lst))
                (cons (rem int 10) (bar (/ int 10) (cdr lst)))
            )
            (bar int '(0))
        )
    )
    (foo (vl-string->list (strcase hex)) nil)
)

;; Start Undo  -  Lee Mac
;; Opens an Undo Group.

(defun LM:startundo ( doc )
    (LM:endundo doc)
    (vla-startundomark doc)
)

;; End Undo  -  Lee Mac
;; Closes an Undo Group.

(defun LM:endundo ( doc )
    (while (= 8 (logand 8 (getvar 'undoctl)))
        (vla-endundomark doc)
    )
)

;; Active Document  -  Lee Mac
;; Returns the VLA Active Document Object

(defun LM:acdoc nil
    (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
    (LM:acdoc)
)

(vl-load-com)
(princ
    (strcat
        "\n:: MidLen.lsp | Version 1.1 | \\U+00A9 Lee Mac "
        (menucmd "m=$(edtime,0,yyyy)")
        " www.lee-mac.com ::"
        "\n:: Type \"midlen\" to Invoke ::"
    )
)
(princ)

;;----------------------------------------------------------------------;;
;;                             End of File                              ;;
;;----------------------------------------------------------------------;;

test xem nhé!

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

vanhuyou    25

vanhuyou
Đã đăng
Vào lúc 4/7/2021 tại 21:58, thiep đã nói:

Ơ, đã giúp rồi còn gì? Bạn chạy trên autoCad đời nào? Bạn đã chạy lisp và kết quả như thế nào? chụp hình gửi lên xem?

Cám ơn bác đã đúng ý của em 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

vanhuyou    25

vanhuyou
Đã đăng
Vào lúc 6/7/2021 tại 07:39, DungNguyen685 đã nói: 

;;----------------------=={ Length at Midpoint }==----------------------;;
;                                                                      ;;
;  This program prompts the user for a selection of objects to be      ;;
;  labelled and proceeds to generate an MText object located at        ;;
;  the midpoint of each object displaying a Field Expression           ;;
;  referencing the length of the object.                               ;;
;                                                                      ;;
;  The program is compatible for use with Arcs, Circles, Lines,        ;;
;  LWPolylines, 2D & 3D Polylines, and under all UCS & View settings.  ;;
;                                                                      ;;
;  The program will generate MText objects positioned directly over    ;;
;  the midpoint of each object, and aligned with the object whilst     ;;
;  preserving text readability. The MText will have a background mask  ;;
;  enabled and will use the active Text Style and Text Height settings ;;
;  at the time of running the program.                                 ;;
;----------------------------------------------------------------------;;
;  Author:  Lee Mac, Copyright © 2013  -  www.lee-mac.com              ;;
;----------------------------------------------------------------------;;
;  Version 1.0    -    2013-11-12                                      ;;
;                                                                      ;;
;  - First release.                                                    ;;
;----------------------------------------------------------------------;;
;  Version 1.1    -    2016-01-16                                      ;;
;                                                                      ;;
;  - Modified LM:objectid function to account for 64-bit AutoCAD 2008. ;;
;----------------------------------------------------------------------;;

(defun c:midlen ( / *error* ent fmt idx ins ocs par sel spc txt typ uxa )

    (setq fmt "%lu6") ;; Field Formatting
    (setq pr "%pr0") ;;  Precision
    (setq ps "%ps[,0]") ;;  
    (setq ct "%ct8[0.1]") ;;  
	
	(setq 	sca1 (getvar "DIMTXT"))
	(setq 	sca2 (getvar "DIMSCALE"))
	(setq sca3 (* sca1 sca2))
	(setvar "textsize" sca3)

    (defun *error* ( msg )
        (LM:endundo (LM:acdoc))
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\nError: " msg))
        )
        (princ)
    )
    
    (if
        (setq sel
            (ssget
                (list
                   '(0 . "ARC,CIRCLE,LINE,*POLYLINE")
                   '(-4 . "<NOT")
                       '(-4 . "<AND")
                           '(0 . "POLYLINE")
                           '(-4 . "&")
                           '(70 . 80)
                       '(-4 . "AND>")
                   '(-4 . "NOT>")
                    (if (= 1 (getvar 'cvport))
                        (cons 410 (getvar 'ctab))
                       '(410 . "Model")
                    )
                )
            )
        )
        (progn
            (setq spc
                (vlax-get-property (LM:acdoc)
                    (if (= 1 (getvar 'cvport))
                        'paperspace
                        'modelspace
                    )
                )
            )
            (setq ocs (trans '(0.0 0.0 1.0) 1 0 t)
                  uxa (angle '(0.0 0.0) (trans (getvar 'ucsxdir) 0 ocs t))
            )
            (LM:startundo (LM:acdoc))
            (repeat (setq idx (sslength sel))
                (setq ent (ssname sel (setq idx (1- idx)))
                      par (vlax-curve-getparamatdist ent (/ (vlax-curve-getdistatparam ent (vlax-curve-getendparam ent)) 2.0))
                      ins (vlax-curve-getpointatparam ent par)
                      typ (cdr (assoc 0 (entget ent)))
                )
                (setq txt
                    (vlax-invoke spc 'addmtext ins 0.0
                        (strcat "L="
                            "%<\\AcObjProp Object(%<\\_ObjId " (LM:objectid (vlax-ename->vla-object ent)) ">%)."
                            (cond
                                (   (= "CIRCLE" typ) "Circumference")
                                (   (= "ARC"    typ) "ArcLength")
                                (   "Length"   )
                            )
                            " \\f \"  " fmt pr ps ct " \">%"
                        )
                    )
                )
                (vla-put-backgroundfill  txt :vlax-true)
                (vla-put-attachmentpoint txt acattachmentpointmiddlecenter)
                (vla-put-insertionpoint  txt (vlax-3D-point ins))
                (vla-put-rotation txt (LM:readable (- (angle '(0.0 0.0 0.0) (trans (vlax-curve-getfirstderiv ent par) 0 ocs t)) uxa)))
            )
            (LM:endundo (LM:acdoc))
        )
    )
    (princ)
)

;; Readable  -  Lee Mac
; Returns an angle corrected for text readability.

(defun LM:readable ( a )
    (   (lambda ( a )
            (if (and (< (* pi 0.5) a) (<= a (* pi 1.5)))
                (LM:readable (+ a pi))
                a
            )
        )
        (rem (+ a pi pi) (+ pi pi))
    )
)

;; ObjectID  -  Lee Mac
; Returns a string containing the ObjectID of a supplied VLA-Object
; Compatible with 32-bit & 64-bit systems

(defun LM:objectid ( obj )
    (eval
        (list 'defun 'LM:objectid '( obj )
            (if (wcmatch (getenv "PROCESSOR_ARCHITECTURE") "*64*")
                (if (vlax-method-applicable-p (vla-get-utility (LM:acdoc)) 'getobjectidstring)
                    (list 'vla-getobjectidstring (vla-get-utility (LM:acdoc)) 'obj ':vlax-false)
                   '(LM:ename->objectid (vlax-vla-object->ename obj))
                )
               '(itoa (vla-get-objectid obj))
            )
        )
    )
    (LM:objectid obj)
)

;; Entity Name to ObjectID  -  Lee Mac
; Returns the 32-bit or 64-bit ObjectID for a supplied entity name

(defun LM:ename->objectid ( ent )
    (LM:hex->decstr
        (setq ent (vl-string-right-trim ">" (vl-prin1-to-string ent))
              ent (substr ent (+ (vl-string-position 58 ent) 3))
        )
    )
)

;; Hex to Decimal String  -  Lee Mac
; Returns the decimal representation of a supplied hexadecimal string

(defun LM:hex->decstr ( hex / foo bar )
    (defun foo ( lst rtn )
        (if lst
            (foo (cdr lst) (bar (- (car lst) (if (< 57 (car lst)) 55 48)) rtn))
            (apply 'strcat (mapcar 'itoa (reverse rtn)))
        )
    )
    (defun bar ( int lst )
        (if lst
            (if (or (< 0 (setq int (+ (* 16 (car lst)) int))) (cdr lst))
                (cons (rem int 10) (bar (/ int 10) (cdr lst)))
            )
            (bar int '(0))
        )
    )
    (foo (vl-string->list (strcase hex)) nil)
)

;; Start Undo  -  Lee Mac
; Opens an Undo Group.

(defun LM:startundo ( doc )
    (LM:endundo doc)
    (vla-startundomark doc)
)

;; End Undo  -  Lee Mac
; Closes an Undo Group.

(defun LM:endundo ( doc )
    (while (= 8 (logand 8 (getvar 'undoctl)))
        (vla-endundomark doc)
    )
)

;; Active Document  -  Lee Mac
; Returns the VLA Active Document Object

(defun LM:acdoc nil
    (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
    (LM:acdoc)
)

(vl-load-com)
(princ
    (strcat
        "\n:: MidLen.lsp | Version 1.1 | \\U+00A9 Lee Mac "
        (menucmd "m=$(edtime,0,yyyy)")
        " www.lee-mac.com ::"
        "\n:: Type \"midlen\" to Invoke ::"
    )
)
(princ)

;;----------------------------------------------------------------------;;
;                             End of File                              ;;
;----------------------------------------------------------------------;;

test xem nhé!

Các bác cho em hỏi thêm là khi em dùng lệnh tcout để đánh số thì cái mtext không áp dụng được, phải explode nó ra mới được

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
×