改进一下，支持大角度.
(defun c:tt (/
ang
c
d data dimsty dimoff dimtxh dimp1 dimp2 dimp3
ent *error*
flg1 flg2
olderr
m1 m2 mt1 mt2
p1 p2
r
)
(defun *error* (msg)
(princ (strcat "\nError: " msg))
(if (= 8 (logand 8 (getvar 'UNDOCTL)))
(vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
)
(setq *error* olderr)
(princ)
)
(defun make_Dim (p1 p2 p3 ang /)
(entmakex
(list
'(0 . "DIMENSION")
'(100 . "AcDbEntity")
'(100 . "AcDbDimension")
(cons 10 p3)
'(11 0. 0. 0.)
'(70 . 32)
'(100 . "AcDbAlignedDimension")
(cons 13 p1)
(cons 14 p2)
(cons 50 ang)
'(100 . "AcDbRotatedDimension")
)
)
)
(defun make_line (p1 p2)
(entmakex (list '(0 . "LINE")
'(100 . "AcDbEntity")
'(100 . "AcDbLine")
(cons 10 p1)
(cons 11 p2)
'(210 0. 0. 1.)
)
)
)
;;;**************************main program**************************;;;
(setq olderr *error*)
(setqp1 (getpoint "\nFirst point:"))
(initget (+ 32 128))
(setqp2 (getpoint p1 "\nSecond point:"))
(if (and
(= 'LIST (type p1))
(= 'LIST (type p2))
(> (distance p1 p2) 250.0)
(setq ent (car (nentselp p1)))
)
(progn
(setq data (entget ent))
(if (equal (cdr (assoc 0 data)) "ARC")
(progn
(vla-StartUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
(setq
ang (angle p1 p2)
m1 (polar p1 ang (* 0.5 (distance p1 p2)))
m2 (vlax-curve-getPointAtDist ent
(* 0.5
(vlax-curve-getdistatparam
ent
(vlax-curve-getendparam ent)
)
)
)
c (cdr (assoc 10 data))
r (cdr (assoc 40 data))
mt1 (polar p1 ang 200.0)
dimsty (tblsearch "Dimstyle" (getvar "dimstyle"))
dimoff (* (cdr (assoc 40 dimsty)) (cdr (assoc 147 dimsty)))
dimtxh (* (cdr (assoc 40 dimsty)) (cdr (assoc 140 dimsty)))
dimtxh (+ dimoff (* 3.0 dimtxh))
dimp1(polar m1ang dimtxh)
dimp2(polar mt1 ang dimtxh)
flg1 (car (trans (mapcar '- m2 p1) 0 (mapcar '- p2 p1)))
flg2 (car (trans (mapcar '- cp1) 0 (mapcar '- p2 p1)))
)
(cond
((or
(and (> flg1 0.0) (> flg2 0.0))
(and (< flg1 0.0) (< flg2 0.0))
)
(setq d (+ (sqrt (- (expt r 2.0) (expt (distance m1 mt1) 2.0))) (distance m1 c)))
)
((or
(and (> flg1 0.0) (<= flg2 0.0))
(and (< flg1 0.0) (>= flg2 0.0))
)
(setq d (- (sqrt (- (expt r 2.0) (expt (distance m1 mt1) 2.0))) (distance m1 c)))
)
)
(setq
ang (angle m1 m2)
mt2 (polar mt1 ang d)
dimp3 (polar mt2 ang dimtxh)
)
(make_line p1p2)
(make_line m1m2)
(make_line mt1 mt2)
(make_Dim m1m2dimp1 (angle m1m2))
(make_Dim mt1 mt2 dimp2 (angle mt1 mt2))
(make_Dim p1mt2 dimp3 (angle p1mt1))
(vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
)
(princ "\nEntity is not an ARC!")
)
)
(princ "\nAt first point can not select ARC entity \nor the distance between 2 points is too short!")
)
(setq *error* olderr)
(princ)
)
本帖最后由 海贼凌源 于 2016-2-20 14:57 编辑
waterchen 发表于 2015-9-5 12:54 static/image/common/back.gif
楼主看看，是不是想要这样效果的。
谢谢你的回答，抱歉回复的晚了。不知道为什么代码在我的电脑里使用没有反应，其他的代码也是，但感觉学习到了不少。 海贼凌源 发表于 2016-2-20 14:55 static/image/common/back.gif
谢谢你的回答，抱歉回复的晚了。不知道为什么代码在我的电脑里使用没有反应，其他的代码也是，但感 ...
再试试这个吧，加多了一句 (vl-load-com)。
(defun c:tt (/
ang
c
d data dimsty dimoff dimtxh dimp1 dimp2 dimp3
ent *error*
flg1 flg2
olderr
m1 m2 mt1 mt2
p1 p2
r
)
(vl-load-com)
(defun *error* (msg)
(princ (strcat "\nError: " msg))
(if (= 8 (logand 8 (getvar 'UNDOCTL)))
(vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
)
(setq *error* olderr)
(princ)
)
(defun make_Dim (p1 p2 p3 ang /)
(entmakex
(list
'(0 . "DIMENSION")
'(100 . "AcDbEntity")
'(100 . "AcDbDimension")
(cons 10 p3)
'(11 0. 0. 0.)
'(70 . 32)
'(100 . "AcDbAlignedDimension")
(cons 13 p1)
(cons 14 p2)
(cons 50 ang)
'(100 . "AcDbRotatedDimension")
)
)
)
(defun make_line (p1 p2)
(entmakex (list '(0 . "LINE")
'(100 . "AcDbEntity")
'(100 . "AcDbLine")
(cons 10 p1)
(cons 11 p2)
'(210 0. 0. 1.)
)
)
)
;;;**************************main program**************************;;;
(setq olderr *error*)
(setqp1 (getpoint "\nGet First point on arc:"))
(initget (+ 32 128))
(if (listp p1)
(setqp2 (getpoint p1 "\nGet Second point on arc:"))
)
(if (and
(listp p1)
(listp p2)
(> (distance p1 p2) 250.0)
(setq ent (car (nentselp p1)))
)
(progn
(setq data (entget ent))
(if (equal (cdr (assoc 0 data)) "ARC")
(progn
(vla-StartUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
(setq
ang (angle p1 p2)
m1 (polar p1 ang (* 0.5 (distance p1 p2)))
m2 (vlax-curve-getPointAtDist ent
(* 0.5
(vlax-curve-getdistatparam
ent
(vlax-curve-getendparam ent)
)
)
)
c (cdr (assoc 10 data))
r (cdr (assoc 40 data))
mt1 (polar p1 ang 200.0)
dimsty (tblsearch "Dimstyle" (getvar "dimstyle"))
dimoff (* (cdr (assoc 40 dimsty)) (cdr (assoc 147 dimsty)))
dimtxh (* (cdr (assoc 40 dimsty)) (cdr (assoc 140 dimsty)))
dimtxh (+ dimoff (* 3.0 dimtxh))
dimp1(polar m1ang dimtxh)
dimp2(polar mt1 ang dimtxh)
flg1 (car (trans (mapcar '- m2 p1) 0 (mapcar '- p2 p1)))
flg2 (car (trans (mapcar '- cp1) 0 (mapcar '- p2 p1)))
)
(cond
((or
(and (> flg1 0.0) (> flg2 0.0))
(and (< flg1 0.0) (< flg2 0.0))
)
(setq d (+ (sqrt (- (expt r 2.0) (expt (distance m1 mt1) 2.0))) (distance m1 c)))
)
((or
(and (> flg1 0.0) (<= flg2 0.0))
(and (< flg1 0.0) (>= flg2 0.0))
)
(setq d (- (sqrt (- (expt r 2.0) (expt (distance m1 mt1) 2.0))) (distance m1 c)))
)
)
(setq
ang (angle m1 m2)
mt2 (polar mt1 ang d)
dimp3 (polar mt2 ang dimtxh)
)
(make_line p1p2)
(make_line m1m2)
(make_line mt1 mt2)
(make_Dim m1m2dimp1 (angle m1m2))
(make_Dim mt1 mt2 dimp2 (angle mt1 mt2))
(make_Dim p1mt2 dimp3 (angle p1mt1))
(vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
)
(princ "\nEntity is not an ARC!")
)
)
(princ "\nAt first point can not select ARC entity \nor the distance between 2 points is too short!")
)
(setq *error* olderr)
(princ)
)
本帖最后由 海贼凌源 于 2016-2-22 17:30 编辑
waterchen 发表于 2016-2-22 10:10 static/image/common/back.gif
再试试这个吧，加多了一句 (vl-load-com)。
谢谢，这回有效果了，是我要的效果。
请问你用什么制作的动图? 海贼凌源 发表于 2016-2-22 17:26 static/image/common/back.gif
谢谢，这回有效果了，是我要的效果。
请问你用什么制作的动图?
制作这个有很多软件，我用的是LICEcap，网上找下就有了。 waterchen 发表于 2016-2-23 09:31 static/image/common/back.gif
制作这个有很多软件，我用的是LICEcap，网上找下就有了。
再次感谢 高手出手那纯属娱乐。只是热心帮忙
页:
1
[2]