请教一下有没有能获取标注注释比例的函数

xiaocainiao

请教一下论坛的各位大神、有没有什么函数、可以获取到标注的注释比例 (如图中所示)

e2002

这部分很少人去搞，下面是代码，供参考，和大家共同学习：

2. 
   
3. ;;============================================================================
   
4. ;;获取对象的注释比例列表值 （对象访问方法）
   
5. 
   
6. (defun lkax_Annotative_GetEntityAnnoScales (en / ob xDicts lxDicts oDict loScales x y lenScales lelScales lScale_Name_Value)
   
7.   (setq ob (vlax-ename->vla-object en))
   
8.   (if (= (vla-get-HasExtensionDictionary ob) :VLAX-TRUE)
   
9.     (progn
   
10.       (setq xDicts (vla-GetExtensionDictionary ob))
    
11.       (setq lxDicts '())
    
12.       (vlax-for item xDicts
    
13.     (setq lxDicts (cons item lxDicts))
    
14.       )
    
15.       (setq lxDicts (reverse lxDicts))
    
16.       (setq vvv (nth 0 lxDicts))
    
17.       (setq oDict  (vla-item vvv 0))
    
18.       (setq loScales '())
    
19.       (vlax-for item oDict
    
20.     (setq loScales (cons item loScales))
    
21.       )
    
22.       (setq lenScales (mapcar 'vlax-vla-object->ename loScales))
    
23.       (setq lelScales (mapcar '(lambda (x) (cdr (assoc 340 (entget x)))) lenScales))
    
24.       (setq lScale_Name_Value (mapcar '(lambda (x) (mapcar '(lambda (y) (cdr (assoc y (entget x)))) '(300 140 141))) lelScales))
    
25.       (setq lReturn (reverse lScale_Name_Value))
    
26.     )
    
27.   );_fi
    
28. );_defun
    
29. 
    

<br /> ;;============================================================================<br /> ;;获取对象的注释比例列表值 （对象访问方法）<br /> <br /> (defun lkax_Annotative_GetEntityAnnoScales (en / ob xDicts lxDicts oDict loScales x y lenScales lelScales lScale_Name_Value)<br />   (setq ob (vlax-ename->vla-object en))<br />   (if (= (vla-get-HasExtensionDictionary ob) :VLAX-TRUE)<br />     (progn<br />       (setq xDicts (vla-GetExtensionDictionary ob))<br />       (setq lxDicts '())<br />       (vlax-for item xDicts<br />     (setq lxDicts (cons item lxDicts))<br />       )<br />       (setq lxDicts (reverse lxDicts))<br />       (setq vvv (nth 0 lxDicts))<br />       (setq oDict  (vla-item vvv 0))<br />       (setq loScales '())<br />       (vlax-for item oDict<br />     (setq loScales (cons item loScales))<br />       )<br />       (setq lenScales (mapcar 'vlax-vla-object->ename loScales))<br />       (setq lelScales (mapcar '(lambda (x) (cdr (assoc 340 (entget x)))) lenScales))<br />       (setq lScale_Name_Value (mapcar '(lambda (x) (mapcar '(lambda (y) (cdr (assoc y (entget x)))) '(300 140 141))) lelScales))<br />       (setq lReturn (reverse lScale_Name_Value))<br />     )<br />   );_fi<br /> );_defun<br /> <br />

2. 
   
3. ;;获取对象的注释比例列表值 (传统 LISP 函数）
   
4. 
   
5. (defun lkvl_Annotative_GetEntityAnnoScales (en / el v360 v350 elDictScales lenScales lelScales v340 elScale l lReturn)
   
6.    (if (lkvl_en_AnnotativeP en)
   
7.     (progn
   
8.       (setq el   (entget en)
   
9.             v360 (cdr (assoc 360 el))
   
10.         v360 (cdr (assoc 360 (entget v360)))
    
11.         v350 (cdr (assoc 350 (entget v360)))
    
12.         elDictScales (entget v350)
    
13.             lenScales (vl-remove-if (function (lambda (x) (/= (car x) 350))) elDictScales)
    
14.         lelScales (mapcar (function (lambda (x) (entget (cdr x)))) lenScales)
    
15.       )
    
16.       (foreach item lelScales
    
17.      (setq v340 (cdr (assoc 340 item))
    
18.            elScale (entget v340)
    
19.            l    (list (cdr (assoc 300 elScale))
    
20.               (cdr (assoc 140 elScale))
    
21.               (cdr (assoc 141 elScale))
    
22.                  )
    
23.            lReturn (cons l lReturn)
    
24.      )
    
25.        );;for
    
26.        (setq lReturn (reverse lReturn))
    
27.      )
    
28.    );_fi
    
29. );_defun
    
30. 
    
31. 
    
32. ;;=====================================
    
33. (defun lkvl_en_AnnotativeP (en / el g-3 l_xdata iFlag)
    
34.   (setq el (entget en '("AcadAnnotative")))
    
35.   (if (setq g-3 (assoc -3 el))
    
36.     (progn
    
37.       (setq l_xdata (cadr g-3)
    
38.         iFlag   (cdr (nth 4 l_xdata));g=1070 ,if iFlag=0 , the object have been changed to not_Annotative.
    
39.       )
    
40.       (and l_xdata (= iFlag 1))
    
41.     )
    
42.   );_fi
    
43. );_defun
    
44. 
    
45. 
    
46. 
    

<br /> ;;获取对象的注释比例列表值 (传统 LISP 函数）<br /> <br /> (defun lkvl_Annotative_GetEntityAnnoScales (en / el v360 v350 elDictScales lenScales lelScales v340 elScale l lReturn)<br />    (if (lkvl_en_AnnotativeP en)<br />     (progn<br />       (setq el   (entget en)<br />             v360 (cdr (assoc 360 el))<br />         v360 (cdr (assoc 360 (entget v360)))<br />         v350 (cdr (assoc 350 (entget v360)))<br />         elDictScales (entget v350)<br />             lenScales (vl-remove-if (function (lambda (x) (/= (car x) 350))) elDictScales)<br />         lelScales (mapcar (function (lambda (x) (entget (cdr x)))) lenScales)<br />       )<br />       (foreach item lelScales<br />      (setq v340 (cdr (assoc 340 item))<br />            elScale (entget v340)<br />            l    (list (cdr (assoc 300 elScale))<br />               (cdr (assoc 140 elScale))<br />               (cdr (assoc 141 elScale))<br />                  )<br />            lReturn (cons l lReturn)<br />      )<br />        );;for<br />        (setq lReturn (reverse lReturn))<br />      )<br />    );_fi<br /> );_defun<br /> <br /> <br /> ;;=====================================<br /> (defun lkvl_en_AnnotativeP (en / el g-3 l_xdata iFlag)<br />   (setq el (entget en '("AcadAnnotative")))<br />   (if (setq g-3 (assoc -3 el))<br />     (progn<br />       (setq l_xdata (cadr g-3)<br />         iFlag   (cdr (nth 4 l_xdata));g=1070 ,if iFlag=0 , the object have been changed to not_Annotative.<br />       )<br />       (and l_xdata (= iFlag 1))<br />     )<br />   );_fi<br /> );_defun<br /> <br /> <br /> <br />

guosheyang

把e版的lisp方法也改了下 在17CAD中可用了
;;获取对象的注释比例列表值 (传统 LISP 函数）
;(lkvl_Annotative_GetEntityAnnoScales (setq en(car(entsel))))
(defun lkvl_Annotative_GetEntityAnnoScales (en / el v360 v350 elDictScales lenScales lelScales v340 elScale l lReturn)
   (if(lkvl_en_AnnotativeP en)
    (progn
      (setq el (entget en)
            v360(cdr (assoc 360 el)))
      (if(and(setq v360(cdr (assoc 360 (entget v360))))
             (assoc 350 (entget v360))
         )
        (setq v350(cdr (assoc 350 (entget v360))))
        (progn
          (setq v360(cdr (assoc 360 el))
                v360(cdr(last(entget v360)))
                v350(cdr (assoc 350 (entget v360))))
        )
      )
      (setq elDictScales (entget v350)
            lenScales (vl-remove-if (function (lambda (x) (/= (car x) 350))) elDictScales)
            lelScales (mapcar (function (lambda (x) (entget (cdr x)))) lenScales))
     (foreach item lelScales
     (setq v340 (cdr (assoc 340 item))
           elScale (entget v340)
           l    (list (cdr (assoc 300 elScale))
              (cdr (assoc 140 elScale))
              (cdr (assoc 141 elScale))
                 )
           lReturn (cons l lReturn)
     )
       );;for
       (setq lReturn (reverse lReturn))
     )
   );_fi
);_defun

;;=====================================
(defun lkvl_en_AnnotativeP (en / el g-3 l_xdata iFlag)
  (setq el (entget en '("AcadAnnotative")))
  (if (setq g-3 (assoc -3 el))
    (progn
      (setq l_xdata (cadr g-3)
        iFlag   (cdr (nth 4 l_xdata));g=1070 ,if iFlag=0 , the object have been changed to not_Annotative.
      )
      (and l_xdata (= iFlag 1))
    )
  );_fi
);_defun

guosheyang

把e版的代码改了一行   在我的17CAD中可以得到正确结果了 ;;============================================================================
;;获取对象的注释比例列表值 （对象访问方法）
;(lkax_Annotative_GetEntityAnnoScales (setq en(car(entsel))))
(defun lkax_Annotative_GetEntityAnnoScales (en / ob xDicts lxDicts oDict loScales x y lenScales lelScales lScale_Name_Value)
  (setq ob (vlax-ename->vla-object en))
  (if (= (vla-get-HasExtensionDictionary ob) :VLAX-TRUE)
    (progn
      (setq xDicts (vla-GetExtensionDictionary ob))
      (setq lxDicts '())
      (vlax-for item xDicts
    (setq lxDicts (cons item lxDicts))
      )
      (setq lxDicts (reverse lxDicts))
      ;(setq vvv (nth 0 lxDicts))
      (if(vlax-property-available-p (nth 0 lxDicts)'count )
         (setq oDict(vla-item (nth 0 lxDicts);|vvv |;0))
         (setq oDict(vla-item (nth 1 lxDicts) 0))
      )
      (setq loScales '())
      (vlax-for item oDict
    (setq loScales (cons item loScales))
      )
      (setq lenScales (mapcar 'vlax-vla-object->ename loScales))
      (setq lelScales (mapcar '(lambda (x) (cdr (assoc 340 (entget x)))) lenScales))
      (setq lScale_Name_Value (mapcar '(lambda (x) (mapcar '(lambda (y) (cdr (assoc y (entget x)))) '(300 140 141))) lelScales))
      (setq lReturn (reverse lScale_Name_Value))
    )
  );_fi
);_defun

guosheyang

(getvar ' CANNOSCALE)

xiaocainiao

e2002 发表于 2022-4-30 09:43
这部分很少人去搞，下面是代码，供参考，和大家共同学习：

谢谢、我去试一下、注释性确实很少有人搞、所以找不到相关的函数

xiaocainiao

guosheyang 发表于 2022-4-30 09:32
(getvar ' CANNOSCALE)

你这只能获取当前注释比例、不是对象的注释比例、不过还是感谢你

自贡黄明儒

e2002 发表于 2022-4-30 09:43
这部分很少人去搞，下面是代码，供参考，和大家共同学习：

版主能解释一下，标注“注释性比例”同“使用全局比例”有什么关系吗？有了“使用全局比例”，还用“注释性比例”做什么？难道“注释性比例”仅仅是使“使用全局比例”保持为1，对后来的尺寸进行标注？

G〆h

使用CAD中自带的命令 OBJECTSCALE 也完全可以实现！

e2002

前两天讨论的如何拆分 Text 为单个字符的Texts 的程序中，就需要处理 Text对象的 Annotative 特性，由于某些功能确实没有提供对象访问的方法，所以不得不在程序中调用了相关注释性比例的命令。