[其他]：DIM 组码分析

eachy

在Dimension的DXF组码中一些特性不能直接得到，下面的程序是为了获取字体高度，测试中觉得有意思，发上来给初学Lisp者在编程方面作为解决问题的一种思考方式。第一个是ActiveX方法，是为了检验能否获取Dim的子实体，在块内实体以及选择集遍历方面，VLa方法更简单易用，第二个是在ActiveX方法测试成功后用纯Lisp 方式来实现，在测试中也看到了Dimension内部各个子实体的规律，先是线然后是两侧的斜，接着写文字，最后是几个Point。

2. 
   
3. [PHP]
   
4. (defun c:test (/ e obj blk hi)
   
5.   (if (setq e (car (entsel)))
   
6.     (progn
   
7.       (setq obj        (vlax-ename->vla-object e);;转换Entity 为 Object
   
8.             blk        (vla-item (vla-get-blocks
   
9.                             (vla-get-activedocument (vlax-get-acad-object))
   
10.                           )
    
11.                           (cdr (assoc 2 (entget e)))
    
12.                 );;获取Dim的块定义本身，不是Reference
    
13.       )
    
14.       (vlax-for        i blk;;遍历块定义
    
15.         ;;(setq elst (cons (vla-get-objectname i) elst));;第一次测试为检验Dim内实体组成
    
16.         (if (= (vla-get-objectname i) "AcDbMText");;看到6个实体后增加获取高度
    
17.           (setq hi (vla-get-height i))
    
18.         )
    
19. 
    
20.       )
    
21.     )
    
22.   )
    
23.   hi
    
24. )
    
25. (defun c:test1 (/ e blk lst hi)
    
26.   (if (setq e (car (entsel "\nSelect Dimension: ")))
    
27.     (progn
    
28.       (setq
    
29.         bn  (cdr (assoc 2 (entget e)));;块名
    
30.         blk (tblobjname "block" bn);;获取块定义本身
    
31.       )
    
32.       (while;;检索块内实体，出现文字停止
    
33.         (/= (cdr
    
34.               (assoc 0
    
35.                      (setq lst (entget (setq blk (entnext blk))))
    
36.               )
    
37.             )
    
38.             "MTEXT"
    
39.         )
    
40.       )
    
41.     )
    
42.   )
    
43.   (cdr (assoc 40 (entget blk)))
    
44. )
    
45. [/PHP]

<br /> [PHP]<br /> (defun c:test (/ e obj blk hi)<br />   (if (setq e (car (entsel)))<br />     (progn<br />       (setq obj        (vlax-ename->vla-object e);;转换Entity 为 Object<br />             blk        (vla-item (vla-get-blocks<br />                             (vla-get-activedocument (vlax-get-acad-object))<br />                           )<br />                           (cdr (assoc 2 (entget e)))<br />                 );;获取Dim的块定义本身，不是Reference<br />       )<br />       (vlax-for        i blk;;遍历块定义<br />         ;;(setq elst (cons (vla-get-objectname i) elst));;第一次测试为检验Dim内实体组成<br />         (if (= (vla-get-objectname i) "AcDbMText");;看到6个实体后增加获取高度<br />           (setq hi (vla-get-height i))<br />         )<br /> <br />       )<br />     )<br />   )<br />   hi<br /> )<br /> (defun c:test1 (/ e blk lst hi)<br />   (if (setq e (car (entsel "\nSelect Dimension: ")))<br />     (progn<br />       (setq<br />         bn  (cdr (assoc 2 (entget e)));;块名<br />         blk (tblobjname "block" bn);;获取块定义本身<br />       )<br />       (while;;检索块内实体，出现文字停止<br />         (/= (cdr<br />               (assoc 0<br />                      (setq lst (entget (setq blk (entnext blk))))<br />               )<br />             )<br />             "MTEXT"<br />         )<br />       )<br />     )<br />   )<br />   (cdr (assoc 40 (entget blk)))<br /> )<br /> [/PHP]

说明：测试仅检验了简单的垂直标注，不含公差等等其他形式，以上测试仅提供一种方法

陌生人

实际字高受dimscale的控制吧？

eachy

最初由 陌生人 发布
[B]实际字高受dimscale的控制吧？ [/B]

打个比喻，Dimscale是过程，字是结果。你用上面的程序测试下就知道了。

心梦相随

谢谢eachy斑竹，我又可以写些小程序了。以前我还以为LISP没办法了。再次谢谢

urljit

为什么会有dim那样的组码呢？
用entnext的

li809

主要用途是什么?