带半径和长度的弧尺寸
嗨，我有个大问题。我在网上找到了一个lisproutine，它可以测量圆弧的半径和长度。太棒了我做了一些调整，比如在测量之前放置文本，但这就是我对autolisp的了解现在我需要帮助。我真的希望文本自动与圆弧对齐，并放置在尺寸线的上方和中间。
如图所示，文字尺寸、箭头和尺寸界线过大。
有没有可能在日常生活中调整这个问题？例如，一次，在你开始测量弧之前？
谢谢
(defun c:arcRL (/ cm fd ar1 ar2 ar3 ar4 ar5 tab oba )
(vl-load-com)
(setq cm (getvar "cmdecho"))
(setvar"cmdecho" 0)
(setq fd (getvar "fielddisplay"))
(if (/= fd 0)(setvar"fielddisplay" 0))
(setq ar1 (entsel "\nSelect an Arc: "))
(setq ar2 (car ar1))
(setq tab (vlax-ename->vla-object ar2))
(setq oba (vla-get-objectid tab))
(setq ar3 (strcat "L=%<\\AcObjProp Object(%<\\_ObjId "
(rtos oba 2 0)
">%).ArcLength \\f \"%ct8%pr0%lu2%ds44>%"))
(setq ar4 (strcat "R=%<\\AcObjProp Object(%<\\_ObjId "
(rtos oba 2 0)
">%).radius \\f \"%pr2%lu2%ds44>%"))
(setq ar5 (strcat " "))
(command "dimangular" ar1 "t" ar5pause)
(command "mtext" pausepause ar4 ar3 )
(setvar"fielddisplay" fd)
(setvar "cmdecho" cm)
(princ)
)
试试这个
(defun c:arcRL (/ acsp ar1 ar2 ar3 ar4 arclen cm cpt dim ep fd
midp mtext mtxtpt oba rad rot sp tab txtpt)
(vl-load-com)
(setq acsp (vla-get-block
(vla-get-activelayout
(vla-get-activedocument
(vlax-get-acad-object)))))
(setq cm (getvar "cmdecho"))
(setvar"cmdecho" 0)
(setq fd (getvar "fielddisplay"))
(if (/= fd 0)(setvar"fielddisplay" 0))
(setq ar1 (entsel "\nSelect an Arc: "))
(setq ar2 (car ar1))
(setq tab (vlax-ename->vla-object ar2))
(setq sp (vlax-curve-getstartpoint tab)
ep (vlax-curve-getendpoint tab)
cpt (vlax-get tab 'Center)
rad (vlax-get tab 'Radius)
arclen (vlax-get tab 'ArcLength)
midp (mapcar (function (lambda (a b)(/ (+ a b) 2))) sp ep)
txtpt (trans (polar cpt (angle cpt midp)(+ rad (* 5 (getvar "DIMTXT"))))1 0)
mtxtpt (trans (polar txtpt (angle midp cpt) (* 2.5 (getvar "DIMTXT")))1 0)
rot (- (angle cpt midp)(/ pi 2))
)
(setq oba (vla-get-objectid tab))
(setq ar3 (strcat "L=%<\\AcObjProp Object(%<\\_ObjId "
(rtos oba 2 0)
">%).ArcLength \\f \"%ct8%pr0%lu2%ds44>%"))
(setq ar4 (strcat "\\PR=%<\\AcObjProp Object(%<\\_ObjId "
(rtos oba 2 0)
">%).Radius \\f \"%pr2%lu2%ds44>%"))
(setq dim (vlax-invoke acsp 'AddDimAngular cpt sp ep txtpt))
(vla-put-textrotation dim rot)
(setq mtext (vlax-invoke acsp 'AddMText mtxtpt 0.0 (strcat ar3 ar4)))
(vla-put-attachmentpoint mtext acAttachmentPointMiddleCenter)
(vlax-invoke mtext 'Rotate cpt rot)
(vlax-put mtext 'InsertionPointmtxtpt)
(vla-put-height mtext (getvar "DIMTXT"))
(setvar"fielddisplay" fd)
(setvar "cmdecho" cm)
(princ)
)
~'J'~ 嗨，菲索，
谢谢你的努力。单击功能和对齐效果完美。还有几点需要改变。
是否可以删除尺寸线之间的度数，文字是否可以放置在尺寸线上方？
在图片上，左边的图片是现在的样子，右边的图片是我想要的样子，如果可能的话。
grz W公司
试试这个
(defun c:arcRL (/ acsp arcent arclen arcobj cm cpt oldht dimht dimobj ep fd id
lenstr midp mtext mtxtpt rad radstr rot sp sset txtpt)
(vl-load-com)
(setq acsp (vla-get-block
(vla-get-activelayout
(vla-get-activedocument
(vlax-get-acad-object))))
)
(setq cm (getvar "cmdecho"))
(setvar"cmdecho" 0)
(setq fd (getvar "fielddisplay"))
(if (/= fd 0)(setvar "fielddisplay" 0))
(if (= (setq oldht(getvar "dimtxt")) 0)
(progn
(initget 7)
(setq dimht (getreal "\nEnter font height for multiline text: "))
(setvar "dimtxt" dimht)
)
)
(prompt "\n>>Select arcs>>")
(if (setq sset (ssget (list (cons 0 "ARC"))))
(while (setq arcent (ssname sset 0))
(setq arcobj (vlax-ename->vla-object arcent))
(setq sp (vlax-curve-getstartpoint arcobj)
ep (vlax-curve-getendpoint arcobj)
cpt (vlax-get arcobj 'Center)
rad (vlax-get arcobj 'Radius)
arclen (vlax-get arcobj 'ArcLength)
midp (vlax-curve-getclosestpointto arcobj
(vlax-curve-getpointatdist arcobj
(/ arclen 2.))
)
txtpt (trans (polar cpt (angle cpt midp)(+ rad (* 5 (getvar "DIMTXT")))) 1 0)
)
(setq id (vla-get-objectid arcobj))
(setq lenstr (strcat "L=%<\\AcObjProp Object(%<\\_ObjId "
(rtos id 2 0)
">%).ArcLength \\f \"%ct8%pr0%lu2%ds44>%"))
(setq radstr (strcat "\\PR=%<\\AcObjProp Object(%<\\_ObjId "
(rtos id 2 0)
">%).Radius \\f \"%pr2%lu2%ds44>%"))
(setq dimobj (vlax-invoke acsp 'AddDimAngular cpt sp ep txtpt))
(setq mtxtpt (trans (polar midp (angle cpt midp) (* 7 (getvar "DIMTXT"))) 1 0)
rot (- (angle cpt midp)(/ pi 2)))
(setq mtext (vlax-invoke acsp 'AddMText mtxtpt 0.0 (strcat lenstr radstr)))
(vla-put-attachmentpoint mtext acAttachmentPointMiddleCenter)
(vlax-invoke mtext 'Rotate cpt rot)
(vlax-put mtext 'InsertionPointmtxtpt)
(vla-put-height mtext (getvar "DIMTXT"))
(vla-put-textoverride dimobj " ")
(vla-update dimobj)
(ssdel arcent sset)
)
)
(setvar"fielddisplay" fd)
(setvar "dimtxt" oldht)
(setvar "cmdecho" cm)
(prin1)
)
~'J'~ 干得好，Fixo！这几乎是我需要的。但我在使用它时注意到的事情仍然很少。我在代码中看到，可以输入文本的高度，但当我运行脚本时，它不起作用。第二件事是尺寸线和文本的方向。它总是在同一个方向上，在某些情况下，它可能对图形的布局不利。你能像下图右侧的例子那样解决这个问题吗？
谢谢！！
对不起，我不能，这超出了我的编程水平
~'J'~
好的，Fixo，没问题。谢谢你的好工作！
grz公司
页:
[1]