求助帖：如图zbbz.vlx：请问这个标注软件引线加上、下标注是怎么实现的
求助帖：如图zbbz.vlx：请问这个标注软件引线加上、下标注是怎么实现的，绘图中需要使用到这种格式的标注，然后需要上、下标注一起导出并一一对应，使用普通的格式导出时可能会乱而不能对应，可不可以提供一下思路？我使用leader+block（仅生成一个block，每次更新一下block）实现了但是导出到xls时所有的标注都是一样的，那个匿名块怎么在leader中使用？有没有别的什么方法和标注格式用属性块 或者 编组 可以方便准确导出 (defun c:drawLeader ()
; (SETVAR "cmdecho" DRAG_CMDECHO_OLD )
; (SETVAR "osmode" DRAG_OSMODE_OLD )
(setq DRAG_OSMODE_OLD (GETVAR "osmode" ))
(SETVAR "osmode" 0 )
(setq DRAG_CMDECHO_OLD
(GETVAR "cmdecho" ))
(SETVAR "cmdecho" 0 )
(setq startPoint (getpoint "\nEnter start point of leader: "))
(setq endPoint (getpoint "\nEnter end point of leader: "))
; (entmake (list '(0 . "LEADER") '(100 . "AcDbEntity") '(100 . "AcDbLeader")
; (cons 10 startPoint) (cons 10 endPoint)))
; (ENTMAKE (LIST '(0 . "LEADER") '(100 . "AcDbEntity") '(100 . "AcDbLeader") '(71 . 1) '(10 0 0 0 ) '(10 0 1 0 )
; (LIST -3 (LIST "ACAD" '(1000 . "DSTYLE") '(1002 . "{") '(1070 . 41) (CONS 1040 startPoint ) '(1070 . 341) (CONS 1005 11 ) '(1002 . "}") ) ) ) )
; (setq blockName "LeaderBlock")
; (setq bz1 "This is the content of the block1.")
; (setq bz2 "This is the content of the block2.")
; (setq bz3 "This is the content of the block3.")
; (setq bz4 "This is the content of the block4.")
; (entmake (list '(0 . "block")
; (cons 2 blockName) '(70 . 0) (cons 10 pt)))
; (repeat (setq i (sslength ss))
; (entmake (cdr (entget (ssname ss (setq i (1- i)))))) )
; (entmake '((0 . "ENDBLK")))
; (command "_.erase" ss "")
; 指定引线起点:
; 指定下一点:
; 指定下一点或 [注释(A)/格式(F)/放弃(U)] <注释>: F 输入引线格式选项 [样条曲线(S)/直线(ST)/箭头(A)/无(N)] <退出>: N
; 指定下一点或 [注释(A)/格式(F)/放弃(U)] <注释>:
; 输入注释文字的第一行或 <选项>: 输入注释选项 [公差(T)/副本(C)/块(B)/无(N)/多行文字(M)] <多行文字>: C
; 选择要复制的对象: 输入注释选项 [公差(T)/副本(C)/块(B)/无(N)/多行文字(M)] <多行文字>: B 输入块名或 [?] <12>: 12
; 单位: 无单位 转换: 1.0000
; 指定插入点或 [基点(B)/比例(S)/X/Y/Z/旋转(R)]:
; 输入 X 比例因子，指定对角点，或 [角点(C)/xyz(XYZ)] <1>: 1 输入 Y 比例因子或 <使用 X 比例因子>: 1
; 指定旋转角度 <0>: 0
(setq bl (createTextAndLineBlock endPoint))
(setq ss1 (ssget "X" (list(cons 8 "fzx"))));构造选择集
(setq layerName "bmtc") ; 指定要删除的图层名称
(command "_layer" "_make" layerName "" "_color" "green" "")
(VL-CMDF "leader" startPoint endPoint "F" "N" "" "" "C" "" "B" bl endPoint 1 1 0)
; ; (VL-CMDF "leader" startPoint endPoint "F" "N" "" "" "C" "" "N" "" endPoint 1 1 0)
; ; (VL-CMDF "leader" startPoint endPoint "F" "N" "" "" "C" ss1 "" "" endPoint 1 1 0)
(command "erase" ss1 "")
; (command "block" bl "" "delete")
; (command "purge" "b" bl)
)
; entmake生成普通块
(defun createTextAndLineBlock (startPoint1)
;对象捕捉
(SETVAR "osmode" 0 )
(vl-load-com)
(setq layerName1 "fzx") ; 指定要删除的图层名称
(command "_layer" "_make" layerName1 "" "_color" "GREEN" "")
(setq text1 "长江东路33")
(setq text2 "长江东路4")
(setq th 1.25) ; 设置文本高度1.25
(setq ta 0) ; 文字旋转角度:0
; 获取最长文本的长度
(setq maxLength (tdaxiao 1 text1 text2))
; (setq maxLength 7.5)
; (setq startPoint1 (getpoint "\nEnter start point of line: "))
(setq dian1 (list(- (car startPoint1) 0) (- (cadr startPoint1) 0 0)))
(setq endPoint1 (list(+ (car startPoint1) (+ maxLength 1.5)) (- (cadr startPoint1) 0 0)))
(setq midPoint (polar startPoint1 (angle startPoint1 endPoint1) (/ (distance startPoint1 endPoint1) 2)))
(entmake (list '(0 . "LINE") (cons 10 startPoint1) (cons 11 endPoint1)))
(setq textpoint1 (list(+ (car startPoint1) (+ (/ maxLength 2) 0.75)) (+ (cadr startPoint1) 0.8 0.1)))
(setq textpoint2 (list(+ (car textpoint1)) (- (cadr textpoint1) 1.8)))
(setq textpoint1 (list(+ (car midPoint)) (+ (cadr midPoint) 0.8 0.1)))
(setq textpoint2 (list(+ (car midPoint)) (- (cadr midPoint) 0.8 0.1)))
(setq textpoint3 (list(+ (car midPoint)) (- (cadr midPoint) 2.6 0.1)))
(setq textpoint4 (list(+ (car midPoint)) (- (cadr midPoint) 4.4 0.1)))
(setq textpoint5 (list(+ (car midPoint)) (- (cadr midPoint) 6.2 0.1)))
(command "text" "J" "MC" textpoint1 th ta text1)
(command "text" "J" "MC" textpoint2 th ta text2)
; (command "text" "J" "MC" textpoint3 th ta text3)
; (command "text" "J" "MC" textpoint4 th ta text4)
; (command "text" "J" "MC" textpoint5 th ta text5)
(setq blockName "TextAndLineBlock4")
(setq ss (ssget "X" (list(cons 8 layerName1))));构造选择集
(emkblk ss startPoint1 blockName)
; (setq blockName (emkunameblk ss startPoint1))
; (setq blockName (mc-make-unname-block ss))
(princ blockName)
(eval blockName)
)
(defun emkblk (ss pt name / i)
(entmake (list '(0 . "block") (cons 2 name) '(70 . 0) (cons 10 pt)))
(repeat (setq i (sslength ss)) (entmake (cdr (entget (ssname ss (setq i (1- i)))))))
(entmake '((0 . "ENDBLK")))
(command "_.erase" ss "")
(entmake (list '(0 . "INSERT") (cons 2 name) (cons 10 pt)))
)这是我的设想 ;;;====================绘图部分START========================
(defun c:entmake ()
(setq point1 (getpoint "\nEnter start point of leader: "))
(setq point2 (getpoint "\nEnter start point of leader: "))
(setq mtext1_data "长江东路1")
(setq mtext2_data "长江东路2")
(entmake
'((0 . "BLOCK")
(2 . "*FSXM_DIMPOINTID_MTEXT")
(70 . 1)
(10 0.0 0.0 0.0)
)
)
;;===============MTEXT1=============
(entmake (list '(0 . "MTEXT")
'(100 . "AcDbEntity")
'(100 . "AcDbMText")
(cons 1 mtext1_data)
;(cons 7 textstyle)
;(cons 8 Layer)
'(10 0 0 0)
(cons 40 1)
;(cons 62 TrueColor)
'(71 . 7)
)
)
;;===============MTEXT2==============
(entmake (list '(0 . "MTEXT")
'(100 . "AcDbEntity")
'(100 . "AcDbMText")
(cons 1 mtext2_data)
'(10 0 0 0)
(cons 40 1)
'(71 . 1)
)
)
(entmake
(list '(0 . "line")
'(10 0 0 0)
'(11 10 0 0)
)
)
(setq textblk_name (entmake '((0 . "ENDBLK"))))
;;================textblk===============
(entmake (list '(0 . "INSERT")
(cons 2 textblk_name)
(cons 10 point2)
)
)
(setq textblk (entlast))
(setq textblk_data (entget textblk))
(setq textblk_hd (fsxm-getdxf 5 textblk_data))
; (get_textblk_list)
; (calc_data)
;;================箭头===============
(setq leader
(entmakex
(list '(0 . "LEADER")
'(100 . "AcDbEntity")
'(100 . "AcDbLeader")
'(71 . 0)
'(72 . 0)
;(cons 3 dimStyle)
;(cons 8 Layer)
(cons 10 point1)
(cons 10 point2)
(list -3
(list "fsxm.dimpointid"
(cons 1000 "LEADER")
)
)
)
)
)
(setq leader_obj (vlax-ename->vla-object leader))
(setq leader_data (entget leader))
(setq leader_hd (fsxm-getdxf 5 leader_data))
)
;;====================绘图部分END=====================
这是fssx里的绘制代码，但是我用他自带的fsxm-write-list2->excel函数无法导出 (defun fsxm-write-list2->excel (list2 / no1 range x xl y)
(if (and (setq xl (vlax-get-Object "Excel.Application"))
(setq range (vlax-get-property xl 'Selection))
(setq no1 (vlax-variant-value (vlax-get-property range 'item 1)))
)
(progn
(setq x -1)
(foreach a list2
(setq x (1+ x))
(setq y -1)
(foreach b a
(setq y (1+ y))
(setq th (vlax-get-property no1 'offset x y))
(vlax-put th 'Value b)
)
)
(vlax-release-object xl)
t
)
)
)
(regapp "fsxm.dimpointid")
;;;==========================主程式==========================
(defun c:fsxm_write_dim_to_excel (/ data EN EN_LST N SS SSLEN)
(princ "\n请选取需导出的座标标注:")
(setq ss (ssget '((-3 ("fsxm.dimpointid" (1000 . "LEADER"))))))
(if ss
(progn (setq n 0
sslen (sslength ss)
)
(princ
(strcat "\n共选择了:(" (itoa sslen) ")组座标注!")
)
(princ "\nfsxm座标标注资料提取中请稍候.......")
(repeat sslen
(setq en (ssname ss n))
(setq en_lst (cons en en_lst))
(setq n (1+ n))
)
(setq data
(fsxm_dimpointid
'(progn
(mapcar
'(lambda (leader)
; (getdimen)
; (setq point1 (vlax-curve-getPointAtParam LEADER 0))
(list (strcat ":" (fsxm-getdxf 5 leader_data))
;引线句柄
(fsxm-getdxf 1 mtext1_data) ;上方文字1
(fsxm-getdxf 1 mtext2_data) ;下方文字2
; (car point1) ;WCS:X
; (cadr point1) ;WCS:Y
)
)
(reverse en_lst)
)
)
)
)
(setq data
(vl-list*
'("飞诗寻梦座标标注外挂系列之:座标资料输出到Excel")
(list (strcat "输出时间:" (rtos (getvar "cdate") 2 6)))
(list "句柄" "上方文字" "下方文字" "在WCS中X" "在WCS中Y")
data
)
)
(princ (strcat "\nfsxm座标标注资料提取完成"
"\n开始写出资料到Excel请稍候......."
)
)
(if (fsxm-write-list2->excel data)
(alert (princ "\n标注资料写出完成!\n请检视Excel"))
(alert (princ "\n未检测到正在运行的Excel文档!程式退出!"))
)
)
)
(princ)
)这是fsxm-write-list2->excel 代码 有没有大神帮忙实现一下？只需要实现类适于上图中的标注格式并且能导出xls，且导出到xls时每一组标注的上标注和下标注一一对应，其它的功能全部不需要 飞雪神光 发表于 2024-4-22 23:05
用属性块 或者 编组 可以方便准确导出
具体怎么实现啊，搞了一个星期了 头都大了 h2295 发表于 2024-4-23 00:06
具体怎么实现啊，搞了一个星期了 头都大了
属性块也是块的一种但是比普通块获取数据方便 也方便修改数据就是引线是固定的 建块方法是属性文字和引线一起建块使用编组也比较方便 可以通过一个图元得到整个组的图元 明经上有建组的代码 联系我吧，给你写一个多重引线的版本，事情就简单了 这是网蜂写的呀，可以正确导出坐标的。网蜂修修改改，写得很复杂。用leader+字段，就简单多了
页:
[1]