批量标注圆弧长度，有问题！！！！

杜阳

各位老师好，写了一个批量标注圆弧长度的代码，执行错误。请各位老师给予指正 谢谢
(defun c:tt()
;以下文件由用户选择
(setvar "CMDECHO" 0)
(setq multi (getvar 'dimlfac));;;add 2002.5.15 can remove
(setq ss (ssget))
(setq l 10)
(setq n (sslength ss))
(repeat n
(setq en (ssname ss (1- n)))
(setq endata(entget en))
(setq entype (cdr (assoc 0 endata)))
(SETQ PC (cdr (ASSOC 10 endata))
  R   (cdr (ASSOC 40 endata))
  PT1 (polar pc (cdr (ASSOC 50 endata)) R)
  PT2 (polar pc (cdr (ASSOC 51 endata)) R)
  pmt(xyp-get-MidPoint pt1 pt2)
  ag(angle pc pmt)
  pt (polar pc ag (+ r l))
)
   (setq angs (assoc 50 endata))
   (setq angs (cdr angs))
   (setq ange (assoc 51 endata))
   (setq ange (cdr ange))
   (setq ang (- ange angs))
   (if (< ang 0)
     (setq ang (- (* 2 pi) (abs ang)))
   )
   (setq larc (* r ang))
   (setq larc (* larc multi));;;add 2002.2.20 can remove
  (setq larc  (rtos larc 2 1))
(command "dimangular"  en "t" larc pt1)
(setq n (1- n))
;;  (command "dimangular"  en "t" larc pt)
)  
(prin1)
)
;;&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
;; 两点之中点 (xyp-get-MidPoint p1 p2)
(defun xyp-get-MidPoint (p1 p2) (mapcar '(lambda (x) (* x 0.5)) (mapcar '+ p1 p2)))

xyp1964

2. ;; tt(批量标注圆弧长度)
   
3. (defun c:tt ()
   
4.   (setvar "CMDECHO" 0)
   
5.   (setq ss (ssget '((0 . "arc")))
   
6.         i  -1
   
7.   )
   
8.   (while (setq s1 (ssname ss (setq i (1+ i))))
   
9.     (setq pc (xyp-DXF 10 s1)
   
10.           pt (xyp-get-CurveMidPoint s1)
    
11.           pt (polar pt (angle pc pt) 500)
    
12.           ll (rtos (xyp-CurveLength s1) 2 2)
    
13.     )
    
14.     (command "dimangular" (list s1 pmt) "t" ll pt)
    
15.   )
    
16.   (princ)
    
17. )

;; tt(批量标注圆弧长度)<br /> (defun c:tt ()<br />   (setvar "CMDECHO" 0)<br />   (setq ss (ssget '((0 . "arc")))<br />         i  -1<br />   )<br />   (while (setq s1 (ssname ss (setq i (1+ i))))<br />     (setq pc (xyp-DXF 10 s1)<br />           pt (xyp-get-CurveMidPoint s1)<br />           pt (polar pt (angle pc pt) 500)<br />           ll (rtos (xyp-CurveLength s1) 2 2)<br />     )<br />     (command "dimangular" (list s1 pmt) "t" ll pt)<br />   )<br />   (princ)<br /> )

杜阳

xyp1964 发表于 2016-1-26 22:57

谢谢院长了    真简练的代码   牛

杜阳

xyp1964 发表于 2016-1-26 22:57

(defun c:tt()
(setvar "cmdecho" 0)
(setq ss(ssget '((0.arc)))
       i -1
)
(while (setq s1(ssname ss (setq i (1+ i))))
(setq pc (xyp-dxf 10 s1)
       pt(xyp-get-curvemifpoint s1)
       pmt(polar pt (angle pc pt) 500)
       ll(rots (xyp-curvelength s1) 2 2)
)
(command "dimangular" (list s1 pmt) "t" ll pt)
)
(princ)
)
院长  是不是输错了一个  pmt没有定义啊

xyp1964

杜阳 发表于 2016-1-28 17:24
(defun c:tt()
(setvar "cmdecho" 0)
(setq ss(ssget '((0.arc)))

用不了也别瞎改：
'((0.arc)) → '((0 . “arc”))
xyp-get-curvemifpoint  → xyp-get-CurveMidPoint
rots → rtos

杜阳

xyp1964 发表于 2016-1-29 18:24
用不了也别瞎改：
'((0.arc)) → '((0 . “arc”))
xyp-get-curvemifpoint  → xyp-get-CurveMidPoint
...

谁说用不了啊   我能用了   那个代码是照你那个抄错了   调试成功了  有工具箱  什么用不了啊   呵呵

杜阳

杜阳 发表于 2016-1-29 19:21
谁说用不了啊   我能用了   那个代码是照你那个抄错了   调试成功了  有工具箱  什么用不了啊   呵呵

[em45

杜阳

经过学习  修改   我的代码也实现了
(defun c:tt()
;以下文件由用户选择
(setvar "CMDECHO" 0)
(setvar "osmode" 0)
(setq multi (getvar 'dimlfac));;;add 2002.5.15 can remove
(setq ss (ssget))
(setq l 1)
(setq n (sslength ss))
(repeat n
(setq en (ssname ss (1- n)))
(setq endata(entget en))
(setq entype (cdr (assoc 0 endata)))
(SETQ PC (cdr (ASSOC 10 endata))
  R   (cdr (ASSOC 40 endata))
  PT1 (polar pc (cdr (ASSOC 50 endata)) R)
  PT2 (polar pc (cdr (ASSOC 51 endata)) R)
  pmt(PLF-get-MidPoint pt1 pt2)
  ag(angle pc pmt)
  pt (polar pc ag (+ r l))
)
          (setq angs (assoc 50 endata))
          (setq angs (cdr angs))
          (setq ange (assoc 51 endata))
          (setq ange (cdr ange))
          (setq ang (- ange angs))
          (if (< ang 0)
            (setq ang (- (* 2 pi) (abs ang)))
          )
          (setq larc (* r ang))
          (setq larc (* larc multi));;;add 2002.2.20 can remove
  (setq larc  (rtos larc 2 1))

(command "dimangular"  (list en pmt) "t" larc pt)
(setq n (1- n))
)               
(prin1)
)
;;&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
;; PLF-get-MidPoint 两点之中点 (xyp-get-MidPoint p1 p2)
(defun PLF-get-MidPoint (p1 p2) (mapcar '(lambda (x) (* x 0.5)) (mapcar '+ p1 p2)))

水仙的错

能不能设置下标注离弧线的距离啊？