求助帖：如图zbbz.vlx：请问这个标注软件引线加上、下标注是怎么实现的

h2295

求助帖：如图zbbz.vlx：请问这个标注软件引线加上、下标注是怎么实现的，绘图中需要使用到这种格式的标注，然后需要上、下标注一起导出并一一对应，使用普通的格式导出时可能会乱而不能对应，可不可以提供一下思路？我使用leader+block（仅生成一个block，每次更新一下block）实现了但是导出到xls时所有的标注都是一样的，那个匿名块怎么在leader中使用？有没有别的什么方法和标注格式

飞雪神光

用属性块 或者 编组 可以方便准确导出

h2295

2. (defun c:drawLeader ()
   
3.   
   
4.   ; (SETVAR "cmdecho" DRAG_CMDECHO_OLD )
   
5.   ; (SETVAR "osmode" DRAG_OSMODE_OLD )
   
6.   (setq DRAG_OSMODE_OLD (GETVAR "osmode" ))
   
7.   (SETVAR "osmode" 0 )
   
8.   (setq DRAG_CMDECHO_OLD
   
9.          (GETVAR "cmdecho" ))
   
10.   (SETVAR "cmdecho" 0 )  
    
11.   (setq startPoint (getpoint "\nEnter start point of leader: "))
    
12.   (setq endPoint (getpoint "\nEnter end point of leader: "))
    
13.   ; (entmake (list '(0 . "LEADER") '(100 . "AcDbEntity") '(100 . "AcDbLeader")  
    
14.   ;                 (cons 10 startPoint) (cons 10 endPoint)))
    
15.   ; (ENTMAKE (LIST '(0 . "LEADER") '(100 . "AcDbEntity") '(100 . "AcDbLeader") '(71 . 1) '(10 0 0 0 ) '(10 0 1 0 )
    
16.   ;                 (LIST -3 (LIST "ACAD" '(1000 . "DSTYLE") '(1002 . "{") '(1070 . 41) (CONS 1040 startPoint ) '(1070 . 341) (CONS 1005 11 ) '(1002 . "}") ) ) ) )
    
17.   ; (setq blockName "LeaderBlock")
    
18.   ; (setq bz1 "This is the content of the block1.")
    
19.   ; (setq bz2 "This is the content of the block2.")
    
20.   ; (setq bz3 "This is the content of the block3.")
    
21.   ; (setq bz4 "This is the content of the block4.")
    
22.   ; (entmake (list '(0 . "block")
    
23.   ;                 (cons 2 blockName) '(70 . 0) (cons 10 pt)))
    
24.   ; (repeat (setq i (sslength ss))
    
25.   ;   (entmake (cdr (entget (ssname ss (setq i (1- i)))))) )
    
26.   ; (entmake '((0 . "ENDBLK")))
    
27.   ; (command "_.erase" ss "")
    
28. ; 指定引线起点:
    
29. ; 指定下一点:
    
30. ; 指定下一点或 [注释(A)/格式(F)/放弃(U)] <注释>: F 输入引线格式选项 [样条曲线(S)/直线(ST)/箭头(A)/无(N)] <退出>: N
    
31. ; 指定下一点或 [注释(A)/格式(F)/放弃(U)] <注释>:
    
32. ; 输入注释文字的第一行或 <选项>: 输入注释选项 [公差(T)/副本(C)/块(B)/无(N)/多行文字(M)] <多行文字>: C
    
33. ; 选择要复制的对象: 输入注释选项 [公差(T)/副本(C)/块(B)/无(N)/多行文字(M)] <多行文字>: B 输入块名或 [?] <12>: 12
    
34. ; 单位: 无单位   转换:    1.0000
    
35. ; 指定插入点或 [基点(B)/比例(S)/X/Y/Z/旋转(R)]:
    
36. ; 输入 X 比例因子，指定对角点，或 [角点(C)/xyz(XYZ)] <1>: 1 输入 Y 比例因子或 <使用 X 比例因子>: 1
    
37. ; 指定旋转角度 <0>: 0
    
38.   (setq bl (createTextAndLineBlock endPoint))
    
39.   (setq ss1 (ssget "X" (list(cons 8 "fzx"))));构造选择集
    
40.   (setq layerName "bmtc") ; 指定要删除的图层名称
    
41.   (command "_layer" "_make" layerName "" "_color" "green" "")
    
42.   (VL-CMDF "leader" startPoint endPoint "F" "N" "" "" "C" "" "B" bl endPoint 1 1 0)
    
43.   ; ; (VL-CMDF "leader" startPoint endPoint "F" "N" "" "" "C" "" "N" "" endPoint 1 1 0)
    
44.   ; ; (VL-CMDF "leader" startPoint endPoint "F" "N" "" "" "C" ss1 "" "" endPoint 1 1 0)
    
45. 
    
46.   
    
47.   
    
48.   (command "erase" ss1 "")
    
49.   ; (command "block" bl "" "delete")
    
50.   ; (command "purge" "b" bl)
    
51.   
    
52. )
    
53. ; entmake生成普通块
    
54. (defun createTextAndLineBlock (startPoint1)
    
55.   ;对象捕捉
    
56.   (SETVAR "osmode" 0 )
    
57.   (vl-load-com)
    
58.   (setq layerName1 "fzx") ; 指定要删除的图层名称
    
59.   (command "_layer" "_make" layerName1 "" "_color" "GREEN" "")
    
60.   
    
61.   (setq text1 "长江东路33")
    
62.   (setq text2 "长江东路4")
    
63.   
    
64.   (setq th 1.25) ; 设置文本高度1.25
    
65.   (setq ta 0) ; 文字旋转角度:0
    
66.   ; 获取最长文本的长度
    
67.   (setq maxLength (tdaxiao 1 text1 text2))
    
68.   ; (setq maxLength 7.5)
    
69.   ; (setq startPoint1 (getpoint "\nEnter start point of line: "))
    
70.   (setq dian1 (list(- (car startPoint1) 0) (- (cadr startPoint1) 0 0)))
    
71.         (setq endPoint1 (list(+ (car startPoint1) (+ maxLength 1.5)) (- (cadr startPoint1) 0 0)))
    
72.   (setq midPoint (polar startPoint1 (angle startPoint1 endPoint1) (/ (distance startPoint1 endPoint1) 2)))
    
73.   (entmake (list '(0 . "LINE") (cons 10 startPoint1) (cons 11 endPoint1)))
    
74.   
    
75.   (setq textpoint1 (list(+ (car startPoint1) (+ (/ maxLength 2) 0.75)) (+ (cadr startPoint1) 0.8 0.1)))
    
76.   (setq textpoint2 (list(+ (car textpoint1)) (- (cadr textpoint1) 1.8)))
    
77.   
    
78.   (setq textpoint1 (list(+ (car midPoint)) (+ (cadr midPoint) 0.8 0.1)))
    
79.   (setq textpoint2 (list(+ (car midPoint)) (- (cadr midPoint) 0.8 0.1)))
    
80.   (setq textpoint3 (list(+ (car midPoint)) (- (cadr midPoint) 2.6 0.1)))
    
81.   (setq textpoint4 (list(+ (car midPoint)) (- (cadr midPoint) 4.4 0.1)))
    
82.   (setq textpoint5 (list(+ (car midPoint)) (- (cadr midPoint) 6.2 0.1)))
    
83.   (command "text" "J" "MC" textpoint1 th ta text1)
    
84.   (command "text" "J" "MC" textpoint2 th ta text2)
    
85.   ; (command "text" "J" "MC" textpoint3 th ta text3)
    
86.   ; (command "text" "J" "MC" textpoint4 th ta text4)
    
87.   ; (command "text" "J" "MC" textpoint5 th ta text5)
    
88.   
    
89.   
    
90.   (setq blockName "TextAndLineBlock4")
    
91.   (setq ss (ssget "X" (list(cons 8 layerName1))));构造选择集
    
92.   (emkblk ss startPoint1 blockName)
    
93.   ; (setq blockName (emkunameblk ss startPoint1))
    
94.   ; (setq blockName (mc-make-unname-block ss))
    
95.   (princ blockName)
    
96.   (eval blockName)
    
97. )
    
98. (defun emkblk (ss pt name / i)
    
99.   (entmake (list '(0 . "block") (cons 2 name) '(70 . 0) (cons 10 pt)))
    
100.   (repeat (setq i (sslength ss))    (entmake (cdr (entget (ssname ss (setq i (1- i))))))  )
     
101.   (entmake '((0 . "ENDBLK")))
     
102.   (command "_.erase" ss "")
     
103.   (entmake (list '(0 . "INSERT") (cons 2 name) (cons 10 pt)))
     
104. )这是我的设想

(defun c:drawLeader ()<br />   <br />   ; (SETVAR "cmdecho" DRAG_CMDECHO_OLD ) <br />   ; (SETVAR "osmode" DRAG_OSMODE_OLD ) <br />   (setq DRAG_OSMODE_OLD (GETVAR "osmode" ))<br />   (SETVAR "osmode" 0 ) <br />   (setq DRAG_CMDECHO_OLD <br />          (GETVAR "cmdecho" )) <br />   (SETVAR "cmdecho" 0 )  <br />   (setq startPoint (getpoint "\nEnter start point of leader: "))<br />   (setq endPoint (getpoint "\nEnter end point of leader: "))<br />   ; (entmake (list '(0 . "LEADER") '(100 . "AcDbEntity") '(100 . "AcDbLeader")  <br />   ;                 (cons 10 startPoint) (cons 10 endPoint)))<br />   ; (ENTMAKE (LIST '(0 . "LEADER") '(100 . "AcDbEntity") '(100 . "AcDbLeader") '(71 . 1) '(10 0 0 0 ) '(10 0 1 0 ) <br />   ;                 (LIST -3 (LIST "ACAD" '(1000 . "DSTYLE") '(1002 . "{") '(1070 . 41) (CONS 1040 startPoint ) '(1070 . 341) (CONS 1005 11 ) '(1002 . "}") ) ) ) ) <br />   ; (setq blockName "LeaderBlock")<br />   ; (setq bz1 "This is the content of the block1.")<br />   ; (setq bz2 "This is the content of the block2.")<br />   ; (setq bz3 "This is the content of the block3.")<br />   ; (setq bz4 "This is the content of the block4.") <br />   ; (entmake (list '(0 . "block") <br />   ;                 (cons 2 blockName) '(70 . 0) (cons 10 pt))) <br />   ; (repeat (setq i (sslength ss)) <br />   ;   (entmake (cdr (entget (ssname ss (setq i (1- i)))))) ) <br />   ; (entmake '((0 . "ENDBLK"))) <br />   ; (command "_.erase" ss "") <br /> ; 指定引线起点:<br /> ; 指定下一点:<br /> ; 指定下一点或 [注释(A)/格式(F)/放弃(U)] <注释>: F 输入引线格式选项 [样条曲线(S)/直线(ST)/箭头(A)/无(N)] <退出>: N<br /> ; 指定下一点或 [注释(A)/格式(F)/放弃(U)] <注释>:<br /> ; 输入注释文字的第一行或 <选项>: 输入注释选项 [公差(T)/副本(C)/块(B)/无(N)/多行文字(M)] <多行文字>: C<br /> ; 选择要复制的对象: 输入注释选项 [公差(T)/副本(C)/块(B)/无(N)/多行文字(M)] <多行文字>: B 输入块名或 [?] <12>: 12<br /> ; 单位: 无单位   转换:    1.0000<br /> ; 指定插入点或 [基点(B)/比例(S)/X/Y/Z/旋转(R)]:<br /> ; 输入 X 比例因子，指定对角点，或 [角点(C)/xyz(XYZ)] <1>: 1 输入 Y 比例因子或 <使用 X 比例因子>: 1<br /> ; 指定旋转角度 <0>: 0<br />   (setq bl (createTextAndLineBlock endPoint))<br />   (setq ss1 (ssget "X" (list(cons 8 "fzx"))));构造选择集<br />   (setq layerName "bmtc") ; 指定要删除的图层名称<br />   (command "_layer" "_make" layerName "" "_color" "green" "")<br />   (VL-CMDF "leader" startPoint endPoint "F" "N" "" "" "C" "" "B" bl endPoint 1 1 0) <br />   ; ; (VL-CMDF "leader" startPoint endPoint "F" "N" "" "" "C" "" "N" "" endPoint 1 1 0) <br />   ; ; (VL-CMDF "leader" startPoint endPoint "F" "N" "" "" "C" ss1 "" "" endPoint 1 1 0) <br /> <br />   <br />   <br />   (command "erase" ss1 "")<br />   ; (command "block" bl "" "delete")<br />   ; (command "purge" "b" bl)<br />   <br /> )<br /> ; entmake生成普通块<br /> (defun createTextAndLineBlock (startPoint1)<br />   ;对象捕捉<br />   (SETVAR "osmode" 0 ) <br />   (vl-load-com)<br />   (setq layerName1 "fzx") ; 指定要删除的图层名称<br />   (command "_layer" "_make" layerName1 "" "_color" "GREEN" "")<br />   <br />   (setq text1 "长江东路33")<br />   (setq text2 "长江东路4")<br />   <br />   (setq th 1.25) ; 设置文本高度1.25<br />   (setq ta 0) ; 文字旋转角度:0<br />   ; 获取最长文本的长度<br />   (setq maxLength (tdaxiao 1 text1 text2))<br />   ; (setq maxLength 7.5)<br />   ; (setq startPoint1 (getpoint "\nEnter start point of line: "))<br />   (setq dian1 (list(- (car startPoint1) 0) (- (cadr startPoint1) 0 0)))<br />         (setq endPoint1 (list(+ (car startPoint1) (+ maxLength 1.5)) (- (cadr startPoint1) 0 0)))<br />   (setq midPoint (polar startPoint1 (angle startPoint1 endPoint1) (/ (distance startPoint1 endPoint1) 2)))<br />   (entmake (list '(0 . "LINE") (cons 10 startPoint1) (cons 11 endPoint1)))<br />   <br />   (setq textpoint1 (list(+ (car startPoint1) (+ (/ maxLength 2) 0.75)) (+ (cadr startPoint1) 0.8 0.1)))<br />   (setq textpoint2 (list(+ (car textpoint1)) (- (cadr textpoint1) 1.8)))<br />   <br />   (setq textpoint1 (list(+ (car midPoint)) (+ (cadr midPoint) 0.8 0.1)))<br />   (setq textpoint2 (list(+ (car midPoint)) (- (cadr midPoint) 0.8 0.1)))<br />   (setq textpoint3 (list(+ (car midPoint)) (- (cadr midPoint) 2.6 0.1)))<br />   (setq textpoint4 (list(+ (car midPoint)) (- (cadr midPoint) 4.4 0.1)))<br />   (setq textpoint5 (list(+ (car midPoint)) (- (cadr midPoint) 6.2 0.1)))<br />   (command "text" "J" "MC" textpoint1 th ta text1)<br />   (command "text" "J" "MC" textpoint2 th ta text2)<br />   ; (command "text" "J" "MC" textpoint3 th ta text3)<br />   ; (command "text" "J" "MC" textpoint4 th ta text4)<br />   ; (command "text" "J" "MC" textpoint5 th ta text5)<br />   <br />   <br />   (setq blockName "TextAndLineBlock4")<br />   (setq ss (ssget "X" (list(cons 8 layerName1))));构造选择集<br />   (emkblk ss startPoint1 blockName)<br />   ; (setq blockName (emkunameblk ss startPoint1))<br />   ; (setq blockName (mc-make-unname-block ss))<br />   (princ blockName)<br />   (eval blockName)<br /> )<br /> (defun emkblk (ss pt name / i)<br />   (entmake (list '(0 . "block") (cons 2 name) '(70 . 0) (cons 10 pt)))<br />   (repeat (setq i (sslength ss))    (entmake (cdr (entget (ssname ss (setq i (1- i))))))  )<br />   (entmake '((0 . "ENDBLK")))<br />   (command "_.erase" ss "")<br />   (entmake (list '(0 . "INSERT") (cons 2 name) (cons 10 pt)))<br /> )这是我的设想

h2295

2. ;;;====================绘图部分START========================
   
3.   (defun c:entmake ()
   
4.     (setq point1 (getpoint "\nEnter start point of leader: "))
   
5.     (setq point2 (getpoint "\nEnter start point of leader: "))
   
6.     (setq mtext1_data "长江东路1")
   
7.     (setq mtext2_data "长江东路2")
   
8.     (entmake
   
9.       '((0 . "BLOCK")
   
10.         (2 . "*FSXM_DIMPOINTID_MTEXT")
    
11.         (70 . 1)
    
12.         (10 0.0 0.0 0.0)
    
13.        )
    
14.     )
    
15.     ;;===============MTEXT1=============
    
16.     (entmake (list '(0 . "MTEXT")
    
17.                    '(100 . "AcDbEntity")
    
18.                    '(100 . "AcDbMText")
    
19.                    (cons 1 mtext1_data)
    
20.                   ;  (cons 7 textstyle)
    
21.                   ;  (cons 8 Layer)
    
22.                    '(10 0 0 0)
    
23.                    (cons 40 1)
    
24.                   ;  (cons 62 TrueColor)
    
25.                    '(71 . 7)
    
26.              )
    
27.     )
    
28.     ;;===============MTEXT2==============
    
29.     (entmake (list '(0 . "MTEXT")
    
30.                    '(100 . "AcDbEntity")
    
31.                    '(100 . "AcDbMText")
    
32.                    (cons 1 mtext2_data)
    
33.                    '(10 0 0 0)
    
34.                    (cons 40 1)
    
35.                    '(71 . 1)
    
36.              )
    
37.     )
    
38.     (entmake
    
39.       (list '(0 . "line")
    
40.             '(10 0 0 0)
    
41.             '(11 10 0 0)
    
42.       )
    
43.     )
    
44.     (setq textblk_name (entmake '((0 . "ENDBLK"))))
    
45.     ;;================textblk===============
    
46.     (entmake (list '(0 . "INSERT")
    
47.                    (cons 2 textblk_name)
    
48.                    (cons 10 point2)
    
49.              )
    
50.     )
    
51.     (setq textblk (entlast))
    
52.     (setq textblk_data (entget textblk))
    
53.     (setq textblk_hd (fsxm-getdxf 5 textblk_data))
    
54.     ; (get_textblk_list)
    
55.     ; (calc_data)
    
56.     ;;================箭头===============
    
57.     (setq leader
    
58.            (entmakex
    
59.              (list '(0 . "LEADER")
    
60.                    '(100 . "AcDbEntity")
    
61.                    '(100 . "AcDbLeader")
    
62.                    '(71 . 0)
    
63.                    '(72 . 0)
    
64.                   ;  (cons 3 dimStyle)
    
65.                   ;  (cons 8 Layer)
    
66.                    (cons 10 point1)
    
67.                    (cons 10 point2)
    
68.                    (list -3
    
69.                          (list "fsxm.dimpointid"
    
70.                                (cons 1000 "LEADER")
    
71.                          )
    
72.                    )
    
73.              )
    
74.            )
    
75.     )
    
76.     (setq leader_obj (vlax-ename->vla-object leader))
    
77.     (setq leader_data (entget leader))
    
78.     (setq leader_hd (fsxm-getdxf 5 leader_data))
    
79.   )
    
80.   ;;====================绘图部分END=====================
    
81. 这是fssx里的绘制代码，但是我用他自带的fsxm-write-list2->excel函数无法导出

;;;====================绘图部分START========================<br />   (defun c:entmake ()<br />     (setq point1 (getpoint "\nEnter start point of leader: "))<br />     (setq point2 (getpoint "\nEnter start point of leader: "))<br />     (setq mtext1_data "长江东路1")<br />     (setq mtext2_data "长江东路2")<br />     (entmake<br />       '((0 . "BLOCK")<br />         (2 . "*FSXM_DIMPOINTID_MTEXT")<br />         (70 . 1)<br />         (10 0.0 0.0 0.0)<br />        )<br />     )<br />     ;;===============MTEXT1=============<br />     (entmake (list '(0 . "MTEXT")<br />                    '(100 . "AcDbEntity")<br />                    '(100 . "AcDbMText")<br />                    (cons 1 mtext1_data)<br />                   ;  (cons 7 textstyle)<br />                   ;  (cons 8 Layer)<br />                    '(10 0 0 0)<br />                    (cons 40 1)<br />                   ;  (cons 62 TrueColor)<br />                    '(71 . 7)<br />              )<br />     )<br />     ;;===============MTEXT2==============<br />     (entmake (list '(0 . "MTEXT")<br />                    '(100 . "AcDbEntity")<br />                    '(100 . "AcDbMText")<br />                    (cons 1 mtext2_data)<br />                    '(10 0 0 0)<br />                    (cons 40 1)<br />                    '(71 . 1)<br />              )<br />     )<br />     (entmake<br />       (list '(0 . "line")<br />             '(10 0 0 0)<br />             '(11 10 0 0)<br />       )<br />     )<br />     (setq textblk_name (entmake '((0 . "ENDBLK"))))<br />     ;;================textblk===============<br />     (entmake (list '(0 . "INSERT")<br />                    (cons 2 textblk_name)<br />                    (cons 10 point2)<br />              )<br />     )<br />     (setq textblk (entlast))<br />     (setq textblk_data (entget textblk))<br />     (setq textblk_hd (fsxm-getdxf 5 textblk_data))<br />     ; (get_textblk_list)<br />     ; (calc_data)<br />     ;;================箭头===============<br />     (setq leader<br />            (entmakex<br />              (list '(0 . "LEADER")<br />                    '(100 . "AcDbEntity")<br />                    '(100 . "AcDbLeader")<br />                    '(71 . 0)<br />                    '(72 . 0)<br />                   ;  (cons 3 dimStyle)<br />                   ;  (cons 8 Layer)<br />                    (cons 10 point1)<br />                    (cons 10 point2)<br />                    (list -3<br />                          (list "fsxm.dimpointid"<br />                                (cons 1000 "LEADER")<br />                          )<br />                    )<br />              )<br />            )<br />     )<br />     (setq leader_obj (vlax-ename->vla-object leader))<br />     (setq leader_data (entget leader))<br />     (setq leader_hd (fsxm-getdxf 5 leader_data))<br />   )<br />   ;;====================绘图部分END=====================<br /> 这是fssx里的绘制代码，但是我用他自带的fsxm-write-list2->excel函数无法导出

h2295

2. (defun fsxm-write-list2->excel (list2 / no1 range x xl y)
   
3.   (if (and (setq xl (vlax-get-Object "Excel.Application"))
   
4.            (setq range (vlax-get-property xl 'Selection))
   
5.            (setq no1 (vlax-variant-value (vlax-get-property range 'item 1)))
   
6.       )
   
7.     (progn
   
8.       (setq x -1)
   
9.       (foreach a list2
   
10.         (setq x (1+ x))
    
11.         (setq y -1)
    
12.         (foreach b a
    
13.           (setq y (1+ y))
    
14.           (setq th (vlax-get-property no1 'offset x y))
    
15.           (vlax-put th 'Value b)
    
16.         )
    
17.       )
    
18.       (vlax-release-object xl)
    
19.       t
    
20.     )
    
21.   )
    
22. )
    
23. (regapp "fsxm.dimpointid")
    
24. ;;;==========================主程式==========================
    
25. (defun c:fsxm_write_dim_to_excel (/ data EN EN_LST N SS SSLEN)
    
26.   (princ "\n请选取需导出的座标标注:")
    
27.   (setq ss (ssget '((-3 ("fsxm.dimpointid" (1000 . "LEADER"))))))
    
28.   (if ss
    
29.     (progn (setq n     0
    
30.                  sslen (sslength ss)
    
31.            )
    
32.            (princ
    
33.              (strcat "\n共选择了:(" (itoa sslen) ")组座标注!")
    
34.            )
    
35.            (princ "\nfsxm座标标注资料提取中请稍候.......")
    
36.            (repeat sslen
    
37.              (setq en (ssname ss n))
    
38.              (setq en_lst (cons en en_lst))
    
39.              (setq n (1+ n))
    
40.            )
    
41.            (setq data
    
42.                   (fsxm_dimpointid
    
43.         
    
44.                     '(progn
    
45.                       (mapcar
    
46.                        '(lambda        (leader)
    
47.                           ; (getdimen)
    
48.                           ; (setq point1 (vlax-curve-getPointAtParam LEADER 0))
    
49.                           (list        (strcat ":" (fsxm-getdxf 5 leader_data))
    
50.                                         ;引线句柄
    
51.                                 (fsxm-getdxf 1 mtext1_data) ;上方文字1
    
52.                                 (fsxm-getdxf 1 mtext2_data) ;下方文字2
    
53.                                 ; (car point1) ;WCS:X
    
54.                                 ; (cadr point1) ;WCS:Y
    
55.                           )
    
56.                         )
    
57.                        (reverse en_lst)
    
58.                       )
    
59.                      )
    
60.                   )
    
61.            )
    
62.            (setq data
    
63.                   (vl-list*
    
64.                     '("飞诗寻梦座标标注外挂系列之:座标资料输出到Excel")
    
65.                     (list (strcat "输出时间:" (rtos (getvar "cdate") 2 6)))
    
66.                     (list "句柄" "上方文字" "下方文字" "在WCS中X" "在WCS中Y")
    
67.                     data
    
68.                   )
    
69.            )
    
70.            (princ (strcat "\nfsxm座标标注资料提取完成"
    
71.                           "\n开始写出资料到Excel请稍候......."
    
72.                   )
    
73.            )
    
74.            (if (fsxm-write-list2->excel data)
    
75.              (alert (princ "\n标注资料写出完成!\n请检视Excel"))
    
76.              (alert (princ "\n未检测到正在运行的Excel文档!程式退出!"))
    
77.            )
    
78.     )
    
79.   )
    
80.   (princ)
    
81. )这是fsxm-write-list2->excel 代码

(defun fsxm-write-list2->excel (list2 / no1 range x xl y)<br />   (if (and (setq xl (vlax-get-Object "Excel.Application"))<br />            (setq range (vlax-get-property xl 'Selection))<br />            (setq no1 (vlax-variant-value (vlax-get-property range 'item 1)))<br />       )<br />     (progn<br />       (setq x -1)<br />       (foreach a list2<br />         (setq x (1+ x))<br />         (setq y -1)<br />         (foreach b a<br />           (setq y (1+ y))<br />           (setq th (vlax-get-property no1 'offset x y))<br />           (vlax-put th 'Value b)<br />         )<br />       )<br />       (vlax-release-object xl)<br />       t<br />     )<br />   )<br /> )<br /> (regapp "fsxm.dimpointid")<br /> ;;;==========================主程式==========================<br /> (defun c:fsxm_write_dim_to_excel (/ data EN EN_LST N SS SSLEN)<br />   (princ "\n请选取需导出的座标标注:")<br />   (setq ss (ssget '((-3 ("fsxm.dimpointid" (1000 . "LEADER"))))))<br />   (if ss<br />     (progn (setq n     0<br />                  sslen (sslength ss)<br />            )<br />            (princ<br />              (strcat "\n共选择了:(" (itoa sslen) ")组座标注!")<br />            )<br />            (princ "\nfsxm座标标注资料提取中请稍候.......")<br />            (repeat sslen<br />              (setq en (ssname ss n))<br />              (setq en_lst (cons en en_lst))<br />              (setq n (1+ n))<br />            )<br />            (setq data<br />                   (fsxm_dimpointid<br />         <br />                     '(progn<br />                       (mapcar<br />                        '(lambda        (leader)<br />                           ; (getdimen)<br />                           ; (setq point1 (vlax-curve-getPointAtParam LEADER 0))<br />                           (list        (strcat ":" (fsxm-getdxf 5 leader_data))<br />                                         ;引线句柄<br />                                 (fsxm-getdxf 1 mtext1_data) ;上方文字1<br />                                 (fsxm-getdxf 1 mtext2_data) ;下方文字2<br />                                 ; (car point1) ;WCS:X<br />                                 ; (cadr point1) ;WCS:Y<br />                           )<br />                         )<br />                        (reverse en_lst)<br />                       )<br />                      )<br />                   )<br />            )<br />            (setq data<br />                   (vl-list*<br />                     '("飞诗寻梦座标标注外挂系列之:座标资料输出到Excel")<br />                     (list (strcat "输出时间:" (rtos (getvar "cdate") 2 6)))<br />                     (list "句柄" "上方文字" "下方文字" "在WCS中X" "在WCS中Y")<br />                     data<br />                   )<br />            )<br />            (princ (strcat "\nfsxm座标标注资料提取完成"<br />                           "\n开始写出资料到Excel请稍候......."<br />                   )<br />            )<br />            (if (fsxm-write-list2->excel data)<br />              (alert (princ "\n标注资料写出完成!\n请检视Excel"))<br />              (alert (princ "\n未检测到正在运行的Excel文档!程式退出!"))<br />            )<br />     )<br />   )<br />   (princ)<br /> )这是fsxm-write-list2->excel 代码

h2295

有没有大神帮忙实现一下？只需要实现类适于上图中的标注格式并且能导出xls，且导出到xls时每一组标注的上标注和下标注一一对应，其它的功能全部不需要

h2295

飞雪神光 发表于 2024-4-22 23:05
用属性块 或者 编组 可以方便准确导出

具体怎么实现啊，搞了一个星期了 头都大了

飞雪神光

h2295 发表于 2024-4-23 00:06
具体怎么实现啊，搞了一个星期了 头都大了

属性块也是块的一种  但是比普通块获取数据方便 也方便修改数据就是引线是固定的 建块方法是属性文字和引线一起建块  使用编组也比较方便 可以通过一个图元得到整个组的图元 明经上有建组的代码

liuhe

联系我吧，给你写一个多重引线的版本，事情就简单了

自贡黄明儒

这是网蜂写的呀，可以正确导出坐标的。网蜂修修改改，写得很复杂。用leader+字段，就简单多了