新圆弧尺寸程序
找到了两个执行圆弧标注的例程：首先-需要选择圆弧，
第二，需要弧、圆上的两点。
可以将两者结合起来：选择弧或选择弧上的两个点，并根据“dimarc.lsp”获得弧尺寸
第一个例程：
;DIMMARC.LSP - Dimension an arc with length, rather than angle
;(c) 1998 Tee Square Graphics
(defun C:DIMARC (/ arc ent obj l)
(setq cmd (getvar "cmdecho")
arc (entsel "\nPick ARC to dimension: ")
ent (entget (car arc))
obj (cdr (assoc 0 ent)))
(if (= obj "ARC")
(progn
(setvar "cmdecho" 1)
(setq l (* (cdr (assoc 40 ent))
(if (minusp (setq l (- (cdr (assoc 51 ent))
(cdr (assoc 50 ent)))))
(+ pi pi l) l)))
(command "_.dimangular" arc "_t" (rtos l))
(while (= (logand (getvar "cmdactive") 1) 1)
(command pause))
(setvar "cmdecho" cmd))
(alert "Object selected is not an ARC."))
(princ)
)和秒：
谢谢你。 既然您使用的是ACAD2010，为什么不使用DIMARC命令呢？ Arcdist例程允许选择圆弧或圆上的两点，dimarc没有此选项。现在我们有了将一切结合起来的趋势。。。
为什么不扩展它，使其更有用（IMO）。
我只是不明白为什么要创建角度标注来显示弧长。 我认为，因为角度尺寸的形状在视觉上是正确的，可以描述被测物体（圆弧），而不是度打印长度。给我讲道理。 为了好玩。。。
(defun c:ArcDim (/ *error* AT:CycleThroughSS p1 ent p2 ss d1 d2)
;; label Arc with Dimension between two picked points
;; Alan J. Thompson, 11.14.11
(vl-load-com)
(defun *error* (msg)
(and ent (redraw ent 4))
(and *AcadDoc* (vla-endundomark *AcadDoc*))
(if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,")))
(princ (strcat "\nError: " msg))
)
)
(defun AT:CycleThroughSS (ss / l i e)
;; Cycle through a selection set to choose one
;; ss - selection set
;; Alan J. Thompson, 03.30.11
(if (eq (type ss) 'PICKSET)
(if (eq (setq l (sslength ss)) 1)
(ssname ss 0)
(progn (princ "\n<Tab> to cycle through entities: ")
(redraw (setq e (ssname ss (setq i 0))) 3)
(while (eq (cadr (grread nil 10)) 9)
(mapcar 'redraw (list e (setq e (ssname ss (setq i (rem (1+ i) l))))) '(4 3))
)
(redraw e 4)
e
)
)
)
)
(vla-startundomark
(cond (*AcadDoc*)
((setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
)
)
(cond ((not vla-addDimArc) (alert "AutoCAD version not supported!"))
((not (setq p1 (getpoint "\nSpecify fist point on arc: "))))
((not (setq ent (AT:CycleThroughSS (ssget "_C" p1 p1 '((0 . "ARC"))))))
(alert "Point must be on arc!")
)
((redraw ent 3))
((not (setq p2 (getpoint p1 "\nSpecify other point on arc: "))))
((not (and (setq ss (ssget "_C" p2 p2 '((0 . "ARC"))))
(vl-some '(lambda (e) (equal ent (cadr e))) (ssnamex ss))
)
)
(alert "Point must be on arc!")
)
((vlax-invoke
(vlax-get *AcadDoc*
(if (eq (getvar 'CVPORT) 1)
'Paperspace
'Modelspace
)
)
'addDimArc
(cdr (assoc 10 (entget ent)))
(trans p1 1 0)
(trans p2 1 0)
(vlax-curve-getPointAtDist
ent
(+ (min (setq d1 (vlax-curve-getDistAtPoint ent (trans p1 1 ent)))
(setq d2 (vlax-curve-getDistAtPoint ent (trans p2 1 ent)))
)
(/ (abs (- d1 d2)) 2.)
)
)
)
)
)
(*error* nil)
(princ)
)
我知道李会因为我用vlax曲线*函数来找到中点而大惊小怪，但我记不起数学，而且我有懒惰的习惯。
你可以随心所欲，我不会对任何人大惊小怪的 好吧，好吧，我就问你。你如何从数学上找到它？
但如果修改弧，则会失去关联性，因为文本是覆盖。。。
仅供参考，您可以使用DIMARC命令选择两个点：
Command: _dimarc
Select arc or polyline arc segment:
Specify arc length dimension location, or Partial]: 好吧，我会被诅咒的。忘记我的代码。
仔细想想，这个功能是有意义的，因为它不同于其他Dim*命令。
我认为我仍然更喜欢以下功能，但这不是宏的真正原因。。。再一次，我有一个在端点/端点/半径处绘制圆弧的工具，我每天都会使用它。
(defun c:ArcDim (/ *error* AT:CycleThroughSS cmd p1 ent p2 ss d1 d2)
;; label Arc with Dimension between two picked points
;; Alan J. Thompson, 11.14.11
(vl-load-com)
(defun *error* (msg)
(and ent (redraw ent 4))
(and cmd (setvar 'CMDECHO cmd))
(and *AcadDoc* (vla-endundomark *AcadDoc*))
(if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,")))
(princ (strcat "\nError: " msg))
)
)
(defun AT:CycleThroughSS (ss / l i e)
;; Cycle through a selection set to choose one
;; ss - selection set
;; Alan J. Thompson, 03.30.11
(if (eq (type ss) 'PICKSET)
(if (eq (setq l (sslength ss)) 1)
(ssname ss 0)
(progn (princ "\n<Tab> to cycle through entities: ")
(redraw (setq e (ssname ss (setq i 0))) 3)
(while (eq (cadr (grread nil 10)) 9)
(mapcar 'redraw (list e (setq e (ssname ss (setq i (rem (1+ i) l))))) '(4 3))
)
(redraw e 4)
e
)
)
)
)
(vla-startundomark
(cond (*AcadDoc*)
((setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
)
)
(setq cmd (getvar 'CMDECHO))
(setvar 'CMDECHO 0)
(cond ((not vla-addDimArc) (alert "AutoCAD version not supported!"))
((not (setq p1 (getpoint "\nSpecify fist point on arc: "))))
((not (setq ent (AT:CycleThroughSS (ssget "_C" p1 p1 '((0 . "ARC"))))))
(alert "Point must be on arc!")
)
((redraw ent 3))
((not (setq p2 (getpoint p1 "\nSpecify other point on arc: "))))
((not (and (setq ss (ssget "_C" p2 p2 '((0 . "ARC"))))
(vl-some '(lambda (e) (equal ent (cadr e))) (ssnamex ss))
)
)
(alert "Point must be on arc!")
)
((vl-cmdf "_.dimarc" (list ent p1) "_partial" "_non" p1 "_non" p2 PAUSE))
;;; ((vlax-invoke
;;; (vlax-get *AcadDoc*
;;; (if (eq (getvar 'CVPORT) 1)
;;; 'Paperspace
;;; 'Modelspace
;;; )
;;; )
;;; 'addDimArc
;;; (cdr (assoc 10 (entget ent)))
;;; (trans p1 1 0)
;;; (trans p2 1 0)
;;; (vlax-curve-getPointAtDist
;;; ent
;;; (+ (min (setq d1 (vlax-curve-getDistAtPoint ent (trans p1 1 ent)))
;;; (setq d2 (vlax-curve-getDistAtPoint ent (trans p2 1 ent)))
;;; )
;;; (/ (abs (- d1 d2)) 2.)
;;; )
;;; )
;;; )
;;; )
)
(*error* nil)
(princ)
)
圆弧和圆（无命令）。。。
(defun c:ArcDim (/ *error* AT:CycleThroughSS cmd p1 ent p2 ss d1 d2)
;; label Arc with Dimension between two picked points
;; Alan J. Thompson, 11.14.11
(vl-load-com)
(defun *error* (msg)
(and ent (redraw ent 4))
;;; (and cmd (setvar 'CMDECHO cmd))
(and *AcadDoc* (vla-endundomark *AcadDoc*))
(if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,")))
(princ (strcat "\nError: " msg))
)
)
(defun AT:CycleThroughSS (ss / l i e)
;; Cycle through a selection set to choose one
;; ss - selection set
;; Alan J. Thompson, 03.30.11
(if (eq (type ss) 'PICKSET)
(if (eq (setq l (sslength ss)) 1)
(ssname ss 0)
(progn (princ "\n<Tab> to cycle through entities: ")
(redraw (setq e (ssname ss (setq i 0))) 3)
(while (eq (cadr (grread nil 10)) 9)
(mapcar 'redraw (list e (setq e (ssname ss (setq i (rem (1+ i) l))))) '(4 3))
)
(redraw e 4)
e
)
)
)
)
(vla-startundomark
(cond (*AcadDoc*)
((setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
)
)
;;;(setq cmd (getvar 'CMDECHO))
;;;(setvar 'CMDECHO 0)
(cond ((not vla-addDimArc) (alert "AutoCAD version not supported!"))
((not (setq p1 (getpoint "\nSpecify fist point on arc: "))))
((not (setq ent (AT:CycleThroughSS (ssget "_C" p1 p1 '((0 . "ARC,CIRCLE"))))))
(alert "Point must be on arc!")
)
((redraw ent 3))
((not (setq p2 (getpoint p1 "\nSpecify other point on arc: "))))
((not (and (setq ss (ssget "_C" p2 p2 '((0 . "ARC,CIRCLE"))))
(vl-some '(lambda (e) (equal ent (cadr e))) (ssnamex ss))
)
)
(alert "Point must be on arc!")
)
;;; ((vl-cmdf "_.dimarc" (list ent p1) "_partial" "_non" p1 "_non" p2 PAUSE))
((vlax-invoke
(vlax-get *AcadDoc*
(if (eq (getvar 'CVPORT) 1)
'Paperspace
'Modelspace
)
)
'addDimArc
(cdr (assoc 10 (entget ent)))
(trans p1 1 0)
(trans p2 1 0)
(vlax-curve-getClosestPointTo
ent
(mapcar '(lambda (a b) (/ (+ a b) 2.)) (trans p1 1 ent) (trans p2 1 ent))
)
;;; (vlax-curve-getPointAtDist
;;; ent
;;; (+ (min (setq d1 (vlax-curve-getDistAtPoint ent (trans p1 1 ent)))
;;; (setq d2 (vlax-curve-getDistAtPoint ent (trans p2 1 ent)))
;;; )
;;; (/ (abs (- d1 d2)) 2.)
;;; )
;;; )
)
)
)
(*error* nil)
(princ)
)
页:
[1]
2