Ghi kích thước dạng cung tròn!!!

Lisp ghi kích thước dạng cung tròn.Đây là lisp dành cho Cad2004, còn nhứng phiên bản sau thì có hỗ trợ rồi
--------------------Lad.lsp-----------------------------
(setq cls_dwg(vlr-dwg-reactor nil '((:VLR-beginClose . destroyobj))))

(defun destroyobj(rctr param)
(if(type acadobj)(vlax-release-object acadobj))
(if(type doc)(vlax-release-object doc))
(if(type util)(vlax-release-object util))
(if(type s_sets)(vlax-release-object s_sets))
(setq arc_dim_lst(if(type arc_dim_lst)nil))
(setq initialized(if(type initialized)nil))
(mapcar
'(lambda(rctr_lst)
(foreach rctr-itm rctr_lst
(if(vlr-added-p rctr-itm)
(vlr-remove rctr-itm)
);if
);for
);lambda
(mapcar 'cdr (vlr-reactors))
);mapcar
(vlr-remove-all)
);defun

;*****************************************************************************

(defun *error*(s)
(if(= s "Function cancelled")
(prompt "\Function cancelled by user\n")
(princ)
)
)

;*****************************************************************************

(defun c:lad(/ sel_obj arc_pnt)
(vla-getentity util 'sel_obj 'arc_pnt "Pick the arc to Dimension: ")
(if(=(vla-get-objectname sel_obj)"AcDbArc")
(core sel_obj)
(progn
(alert"You must select an arc!")
(c:lad)
);progn
);if
(princ)
)

;*****************************************************************************

(defun dim_crtr(arc_core / strtpnt endpnt cenvert arclen
arclenstr owner radius
strtpntlst endpntlst cenvertlst
midpnt_x midpnt_y tan_midpnt
textpnt new_dim
)

(setq strtpnt(vla-get-startpoint arc_core))
(setq endpnt(vla-get-endpoint arc_core))
(setq cenvert(vla-get-center arc_core))
(setq arclen(vla-get-arclength arc_core))
(setq arclenstr(rtos arclen(getvar"DIMLUNIT")(getvar"DIMDEC")))
(setq radius(vla-get-radius arc_core))
(setq strtpntlst(vlax-safearray->list(vlax-variant-value strtpnt)))
(setq endpntlst(vlax-safearray->list(vlax-variant-value endpnt)))
(setq cenvertlst(vlax-safearray->list(vlax-variant-value cenvert)))
(setq midpnt_x(/(+(car strtpntlst)(car endpntlst))2))
(setq midpnt_y(/(+(cadr strtpntlst)(cadr endpntlst))2))
(setq midpnt_x_quart(- midpnt_x (car cenvertlst)))
(setq midpnt_y_quart(- midpnt_y (cadr cenvertlst)))
(setq strtangl(vla-get-startangle arc_core))
(setq totangl(vla-get-totalangle arc_core))
(setq textpnt
(vlax-3d-point
(polar cenvertlst (+ strtangl(/ totangl 2))(+(/ radius 10)radius))
)
)
(setq owner(vla-get-ownerid arc_core))
(if(= owner(vla-get-objectid(vla-get-modelspace doc)))
(progn
(setq new_dim(vla-addDim3PointAngular(vla-get-modelspace doc)
cenvert strtpnt endpnt textpnt
)
);setq
);progn
(progn
(setq new_dim(vla-addDim3PointAngular(vla-get-paperspace doc)
cenvert strtpnt endpnt textpnt
)
);setq
);progn
);if
(vla-put-textoverride new_dim arclenstr)
new_dim
);defun

;*****************************************************************************

(defun core(arc_lad / rctr_owns new_dim del_dim_assoc del_dim)
(setq rctr_owns(vlr-owners arc_rctr))
(setq new_dim(dim_crtr arc_lad))
(if(member arc_lad rctr_owns)
(progn
(setq del_dim_assoc(assoc arc_lad arc_dim_lst))
(setq del_dim(cdr del_dim_assoc))
(setq arc_dim_lst(subst(cons arc_lad new_dim) del_dim_assoc arc_dim_lst))
(vl-catch-all-apply 'vla-erase(list del_dim))
);progn
(progn
(vlr-owner-add arc_rctr arc_lad)
(setq arc_dim_lst(cons(cons arc_lad new_dim)arc_dim_lst))
);progn
);if
);defun

;*****************************************************************************

(defun arc_mod(arc_ntfr mod_rctr plist)
(if(not(vlax-erased-p arc_ntfr))
(core arc_ntfr)
)
);defun

;*****************************************************************************

(defun initialize (/ s_sets fltr_cod_arc fltr_val_arc arc_col
fltr_cod_dim fltr_val_dim dim_col dim_itm dim_strt_pnt dim_strt_lst
dim_end_pnt dim_end_lst dim_vrt dim_vrt_lst arc_itm arc_strt_pnt
arc_strt_lst arc_end_pnt arc_end_lst arc_cen arc_cen_lst
)
(if(not initialized)
(progn
(obj_set)
(setq s_sets(vla-get-selectionsets doc))
(setq arc_col(vla-add s_sets "arcs"))
(setq dim_col(vla-add s_sets "dims"))
(setq fltr_cod_arc(vlax-make-safearray vlax-vbinteger '(0 . 0)))
(setq fltr_val_arc(vlax-make-safearray vlax-vbvariant '(0 . 0)))
(vlax-safearray-fill fltr_cod_arc '(0))
(vlax-safearray-fill fltr_val_arc '("ARC"))
(vla-select arc_col acSelectionSetAll nil nil fltr_cod_arc fltr_val_arc)
(setq fltr_cod_dim(vlax-make-safearray vlax-vbinteger '(0 . 1)))
(setq fltr_val_dim(vlax-make-safearray vlax-vbvariant '(0 . 1)))
(vlax-safearray-fill fltr_cod_dim '(0 70))
(vlax-safearray-fill fltr_val_dim '("DIMENSION" 37))
(vla-select dim_col acSelectionSetAll nil nil fltr_cod_dim fltr_val_dim)
(vlax-map-collection dim_col
'(lambda(dim_itm)
(setq dim_strt_pnt(vla-get-ExtLine1EndPoint dim_itm))
(setq dim_strt_lst(vlax-safearray->list(vlax-variant-value dim_strt_pnt)))
(setq dim_end_pnt(vla-get-ExtLine2EndPoint dim_itm))
(setq dim_end_lst(vlax-safearray->list(vlax-variant-value dim_end_pnt)))
(setq dim_vrt(vla-get-anglevertex dim_itm))
(setq dim_vrt_lst(vlax-safearray->list(vlax-variant-value dim_vrt)))
(vlax-for arc_itm arc_col
(setq arc_strt_pnt(vla-get-startpoint arc_itm))
(setq arc_strt_lst(vlax-safearray->list(vlax-variant-value arc_strt_pnt)))
(setq arc_end_pnt(vla-get-endpoint arc_itm))
(setq arc_end_lst(vlax-safearray->list(vlax-variant-value arc_end_pnt)))
(setq arc_cen(vla-get-center arc_itm))
(setq arc_cen_lst(vlax-safearray->list(vlax-variant-value arc_cen)))
(if
(and
(=(car arc_strt_lst)(car dim_strt_lst))
(=(cadr arc_strt_lst)(cadr dim_strt_lst))
(=(car arc_end_lst)(car dim_end_lst))
(=(cadr arc_end_lst)(cadr dim_end_lst))
(=(car arc_cen_lst)(car dim_vrt_lst))
(=(cadr arc_cen_lst)(cadr dim_vrt_lst))
);and
(setq arc_dim_lst(cons(cons arc_itm dim_itm)arc_dim_lst))
);if
);for
);lambda
);map
(setq arc_rctr
(vlr-object-reactor(mapcar 'car arc_dim_lst)
"ArcRctMod" '((:vlr-modified . arc_mod))
);rctr
);setq
(setq initialized T)
(prompt"\nType LAD on prompt...\n")
(princ)
);progn
);if
);defun

;*****************************************************************************

(defun obj_set()
(setq acadobj(vlax-get-acad-object))
(setq doc(vla-get-activedocument acadobj))
(setq util(vla-get-utility doc))
)

;*****************************************************************************

(initialize)
-------------------------------------Kết thúc ---------------------------
Update by Updatelisp!

Bạn xem lại code lisp nhé!. Mình load báo lổi

Trích dẫn :

Command: ap
APPLOAD Lad.lsp successfully loaded.
Command: ; error: no function definition: VLR-DWG-REACTOR

Bạn thử lại nhé , mình xài bình thường mà :
-----------------------------Lad.lsp------------------------------------------
;;;CADALYST 02/07 Tip 2182: LAD.LSP Linear Arc Dimension (c) 2007 Michael Kolomiyets


(vl-load-com)

;*****************************************************************************

(setq cls_dwg(vlr-dwg-reactor nil '((:VLR-beginClose . destroyobj))))

(defun destroyobj(rctr param)
(if(type acadobj)(vlax-release-object acadobj))
(if(type doc)(vlax-release-object doc))
(if(type util)(vlax-release-object util))
(if(type s_sets)(vlax-release-object s_sets))
(setq arc_dim_lst(if(type arc_dim_lst)nil))
(setq initialized(if(type initialized)nil))
(mapcar
'(lambda(rctr_lst)
(foreach rctr-itm rctr_lst
(if(vlr-added-p rctr-itm)
(vlr-remove rctr-itm)
);if
);for
);lambda
(mapcar 'cdr (vlr-reactors))
);mapcar
(vlr-remove-all)
);defun

;*****************************************************************************

(defun *error*(s)
(if(= s "Function cancelled")
(prompt "\Function cancelled by user\n")
(princ)
)
)

;*****************************************************************************

(defun c:lad(/ sel_obj arc_pnt)
(vla-getentity util 'sel_obj 'arc_pnt "Pick the arc to Dimension: ")
(if(=(vla-get-objectname sel_obj)"AcDbArc")
(core sel_obj)
(progn
(alert"You must select an arc!")
(c:lad)
);progn
);if
(princ)
)

;*****************************************************************************

(defun dim_crtr(arc_core / strtpnt endpnt cenvert arclen
arclenstr owner radius
strtpntlst endpntlst cenvertlst
midpnt_x midpnt_y tan_midpnt
textpnt new_dim
)

(setq strtpnt(vla-get-startpoint arc_core))
(setq endpnt(vla-get-endpoint arc_core))
(setq cenvert(vla-get-center arc_core))
(setq arclen(vla-get-arclength arc_core))
(setq arclenstr(rtos arclen(getvar"DIMLUNIT")(getvar"DIMDEC")))
(setq radius(vla-get-radius arc_core))
(setq strtpntlst(vlax-safearray->list(vlax-variant-value strtpnt)))
(setq endpntlst(vlax-safearray->list(vlax-variant-value endpnt)))
(setq cenvertlst(vlax-safearray->list(vlax-variant-value cenvert)))
(setq midpnt_x(/(+(car strtpntlst)(car endpntlst))2))
(setq midpnt_y(/(+(cadr strtpntlst)(cadr endpntlst))2))
(setq midpnt_x_quart(- midpnt_x (car cenvertlst)))
(setq midpnt_y_quart(- midpnt_y (cadr cenvertlst)))
(setq strtangl(vla-get-startangle arc_core))
(setq totangl(vla-get-totalangle arc_core))
(setq textpnt
(vlax-3d-point
(polar cenvertlst (+ strtangl(/ totangl 2))(+(/ radius 10)radius))
)
)
(setq owner(vla-get-ownerid arc_core))
(if(= owner(vla-get-objectid(vla-get-modelspace doc)))
(progn
(setq new_dim(vla-addDim3PointAngular(vla-get-modelspace doc)
cenvert strtpnt endpnt textpnt
)
);setq
);progn
(progn
(setq new_dim(vla-addDim3PointAngular(vla-get-paperspace doc)
cenvert strtpnt endpnt textpnt
)
);setq
);progn
);if
(vla-put-textoverride new_dim arclenstr)
new_dim
);defun

;*****************************************************************************

(defun core(arc_lad / rctr_owns new_dim del_dim_assoc del_dim)
(setq rctr_owns(vlr-owners arc_rctr))
(setq new_dim(dim_crtr arc_lad))
(if(member arc_lad rctr_owns)
(progn
(setq del_dim_assoc(assoc arc_lad arc_dim_lst))
(setq del_dim(cdr del_dim_assoc))
(setq arc_dim_lst(subst(cons arc_lad new_dim) del_dim_assoc arc_dim_lst))
(vl-catch-all-apply 'vla-erase(list del_dim))
);progn
(progn
(vlr-owner-add arc_rctr arc_lad)
(setq arc_dim_lst(cons(cons arc_lad new_dim)arc_dim_lst))
);progn
);if
);defun

;*****************************************************************************

(defun arc_mod(arc_ntfr mod_rctr plist)
(if(not(vlax-erased-p arc_ntfr))
(core arc_ntfr)
)
);defun

;*****************************************************************************

(defun initialize (/ s_sets fltr_cod_arc fltr_val_arc arc_col
fltr_cod_dim fltr_val_dim dim_col dim_itm dim_strt_pnt dim_strt_lst
dim_end_pnt dim_end_lst dim_vrt dim_vrt_lst arc_itm arc_strt_pnt
arc_strt_lst arc_end_pnt arc_end_lst arc_cen arc_cen_lst
)
(if(not initialized)
(progn
(obj_set)
(setq s_sets(vla-get-selectionsets doc))
(setq arc_col(vla-add s_sets "arcs"))
(setq dim_col(vla-add s_sets "dims"))
(setq fltr_cod_arc(vlax-make-safearray vlax-vbinteger '(0 . 0)))
(setq fltr_val_arc(vlax-make-safearray vlax-vbvariant '(0 . 0)))
(vlax-safearray-fill fltr_cod_arc '(0))
(vlax-safearray-fill fltr_val_arc '("ARC"))
(vla-select arc_col acSelectionSetAll nil nil fltr_cod_arc fltr_val_arc)
(setq fltr_cod_dim(vlax-make-safearray vlax-vbinteger '(0 . 1)))
(setq fltr_val_dim(vlax-make-safearray vlax-vbvariant '(0 . 1)))
(vlax-safearray-fill fltr_cod_dim '(0 70))
(vlax-safearray-fill fltr_val_dim '("DIMENSION" 37))
(vla-select dim_col acSelectionSetAll nil nil fltr_cod_dim fltr_val_dim)
(vlax-map-collection dim_col
'(lambda(dim_itm)
(setq dim_strt_pnt(vla-get-ExtLine1EndPoint dim_itm))
(setq dim_strt_lst(vlax-safearray->list(vlax-variant-value dim_strt_pnt)))
(setq dim_end_pnt(vla-get-ExtLine2EndPoint dim_itm))
(setq dim_end_lst(vlax-safearray->list(vlax-variant-value dim_end_pnt)))
(setq dim_vrt(vla-get-anglevertex dim_itm))
(setq dim_vrt_lst(vlax-safearray->list(vlax-variant-value dim_vrt)))
(vlax-for arc_itm arc_col
(setq arc_strt_pnt(vla-get-startpoint arc_itm))
(setq arc_strt_lst(vlax-safearray->list(vlax-variant-value arc_strt_pnt)))
(setq arc_end_pnt(vla-get-endpoint arc_itm))
(setq arc_end_lst(vlax-safearray->list(vlax-variant-value arc_end_pnt)))
(setq arc_cen(vla-get-center arc_itm))
(setq arc_cen_lst(vlax-safearray->list(vlax-variant-value arc_cen)))
(if
(and
(=(car arc_strt_lst)(car dim_strt_lst))
(=(cadr arc_strt_lst)(cadr dim_strt_lst))
(=(car arc_end_lst)(car dim_end_lst))
(=(cadr arc_end_lst)(cadr dim_end_lst))
(=(car arc_cen_lst)(car dim_vrt_lst))
(=(cadr arc_cen_lst)(cadr dim_vrt_lst))
);and
(setq arc_dim_lst(cons(cons arc_itm dim_itm)arc_dim_lst))
);if
);for
);lambda
);map
(setq arc_rctr
(vlr-object-reactor(mapcar 'car arc_dim_lst)
"ArcRctMod" '((:vlr-modified . arc_mod))
);rctr
);setq
(setq initialized T)
(prompt"\nType LAD on prompt...\n")
(princ)
);progn
);if
);defun

;*****************************************************************************

(defun obj_set()
(setq acadobj(vlax-get-acad-object))
(setq doc(vla-get-activedocument acadobj))
(setq util(vla-get-utility doc))
)

;*****************************************************************************

(initialize)

;*****************************************************************************


----------------------------Kết thúc-------------------------------------------

Lisp OK, ko sao cả vẫn dùng tốt mà, Thank you so much !

tổng hợp lisp thật là tuyệt
cám ơn trước đã

Sao lại phải ghi kích thước cong với lisp dài quá vậy nhỉ, tôi có viết đoạn lisp có vài dòng cũng ghi được mà!

Cả nhà tham khảo nhé!

[code]
;------------------------------------------------------------------
(prompt "\n ktc : Ghi kich thuoc doan cong")
(defun c:ktc ()
(setq ss (entsel "\nchon cung tron: "))
(defun getArc(en)
(command "lengthen" en "")
(getvar "perimeter")
)
(setq len (getArc ss))
(setq len1 (rtos len 2 2))
(command "_.dim")
(command "ang" ss pause len1 "")
(command "e")
)
(princ "\n\n By LucaDien - trancuongbadien@yahoo.com")
(princ)
;-----------------------------------------------------------------

[code]