快速读取线条表格数据
经常遇到一写表格需要读取，所以写了一个快速读取方法，但是，遇到杂乱的表格，我也写了一个，调用的是cgal来分析的（以后分享，需要cgal的支撑）(defun $kxbg$ (pt1 pt2 lst / entitys $zheng-li$msg $fen-zu$ pts result
fz ss xts)
;框选表格，非中线的表格，太烂的表格不行，还有一个函数$kxbg2$准确率高但是效率低
;示例:($kxbg$ (getpoint) (getpoint) (list (CONS "标题位置" "顶部")(cons "选择集" (ssget))))
(defun $fen-zu$ (entitys / a b
coords current data datas
dxf-0 dxf-10 dxf-11 entdata
hf hori hori-linehorzone
hr new-datas swap text-height
vertical vertical-line verzone
vf vr verzone-key
horzone-key h-jbs v-jbs
)
(foreach entity entitys
(setq entData (entget entity))
(setq dxf-0 (cdr (assoc 0 entData)))
(cond
((wcmatch dxf-0 "[,LINE,LWPOLYLINE,]")
(setq dxf-10 (cdr (assoc 10 entData)))
(setq dxf-11 (cdr (assoc 11 entData)))
(if (and (not dxf-11) (wcmatch dxf-0 "[,LWPOLYLINE,]"))
(progn
(setq dxf-11
(cdr (cadr (vl-remove-if-not
(function (lambda (a)
(member (car a) (list '10 '11))
)
)
entData
)
)
)
)
)
)
(progn
(cond ((< (abs (- (car dxf-10)
(car dxf-11)
)
)
0.18
) ;竖向直线
(setq
vertical (cons (car dxf-10) vertical)
)
(setq vertical-line (cons entity vertical-line))
)
((< (abs (- (cadr dxf-10)
(cadr dxf-11)
)
)
0.18
) ;水平直线
(setq hori (cons (cadr dxf-10) hori))
(setq hori-line (cons entity hori-line))
)
)
)
)
((and (eq dxf-0 "TEXT")
(cdr (assoc 1 entData))
(> (strlen (cdr (assoc 1 entData))) 0)
)
;表格内文字
(IF (= (cdr (assoc 1 entData)) "M30100866")
(PRINT)
)
(progn
(vla-getboundingbox
(vlax-ename->vla-object entity)
'a
'b
) ;外包围
(setq a (vlax-safearray->list a))
(setq b (vlax-safearray->list b))
;(makerec a b)
(setq
coords (mapcar (function (lambda (x y) (* (+ x y) 0.5)))
a
b
)
) ;居中点
(setq datas (cons (cons (cdr (assoc 1 entData))
coords
)
datas
)
)
)
)
)
)
(setq
v-jbs (mapcar (function (lambda (a) (cdr (assoc 5 (entget a)))))
vertical-line
)
)
(setq
h-jbs (mapcar (function (lambda (a) (cdr (assoc 5 (entget a)))))
hori-line
)
)
(setq swap nil)
(setq vertical (vl-sort vertical '<))
(while (progn (setq data (car vertical))
(setq vertical (cdr vertical))
)
(if (> (abs (- data (car vertical))) 0.18)
(setq swap (cons data swap))
)
)
(setq swap (cons data swap))
(setq vertical (reverse swap)
swap nil
)
(setq hori (vl-sort hori '<))
(while (progn (setq data (car hori))
(setq hori (cdr hori))
)
(if (> (abs (- data (car hori))) 0.18)
(setq swap (cons data swap))
)
)
(setq swap (cons data swap))
(setq hori (reverse swap))
(setq swap nil)
(setq verzone (mapcar 'list vertical (cdr vertical)))
(setq verzone-key
(mapcar
(function
(lambda (a i / key)
(cons i a)
)
)
verzone
(wire:range (length verzone))
)
)
(setq horzone (mapcar 'list hori (cdr hori)))
(setq horzone-key
(mapcar
(function
(lambda (a i / key)
(cons i a)
)
)
horzone
(wire:range (length horzone))
)
)
(IFhorzone
()
(PRINT "horzone 空值")
)
(setq
datas (vl-sort datas
(FUNCTION (lambda (a b) (< (cadr a) (cadr b))))
)
)
(IFverzone
(PROGN
(setq current 0)
(setq new-datas '())
(foreach data datas
(setq current nil)
(setqcurrent(VL-SOME
(FUNCTION
(LAMBDA (A / pts pt1 pt2)
(if (and
(setq pt1 (cadr a))
(setq pt2 (caddr a))
(and (> (cadr data) pt1)
(< (cadr data) pt2)
)
)
(car a)
)
)
)
verzone-key
)
)
(if current
(setq new-datas (cons (subst current (cadr data) data)
new-datas
)
)
)
)
)
)
(setq datas new-datas)
(setq
datas (vl-sort datas
(FUNCTION (lambda (a b) (< (caddr a) (caddr b))))
)
)
(setq current 0)
(setq new-datas '())
(foreach data datas
(setq current nil)
(setq current (VL-SOME
(FUNCTION
(LAMBDA(A / pts pt1 pt2)
(if (and
(setq pt1 (cadr a))
(setq pt2 (caddr a))
(and (> (caddr data) pt1)
(< (caddr data) pt2)
)
)
(car a)
)
)
)
horzone-key
)
)
(setq new-datas (cons (subst current (caddr data) data)
new-datas
)
)
)
(setq datas new-datas)
(setq new-datas '())
(foreach data datas
(PROGN
(if (and (car data)
(= (type (cadr data)) 'INT)
(= (type (caddr data)) 'INT)
)
(setqnew-datas (cons(list (car data)
(cadr data)
(caddr data)
)
new-datas
)
)
)
)
)
(setq datas new-datas)
(setq new-datas '())
(setq datas (reverse datas))
(list datas
(list(cons "表格横向线条" h-jbs)
(cons "表格竖向线条" v-jbs)
)
)
)
(defun $zheng-li$ (dataz lst / a bts btwz data old old-cdr y y-key ys)
(SETQ BTWZ (CDR (ASSOC "标题位置" lst)))
(SETQ YS (MAPCAR 'CADDR dataz));Y轴
(SETQ YS (DELSAME YS)) ;排重
(SETQ YS (VL-SORT YS '>)) ;排序
(SETQ Y-KEY NIL)
(while (setq a (car dataz))
(SETQ Y (CADDR A))
(SETQ OLD (ASSOC Y Y-KEY))
(SETQ OLD-CDR (CDR OLD))
(SETQ OLD-CDR (CONS A OLD-CDR))
(SETq Y-KEY (VL-REMOVE OLD Y-KEY))
(SETq Y-KEY (CONS (CONS Y OLD-CDR) Y-KEY))
(setq dataz (cdr dataz))
) ;按照Y轴建立KEY
(cond ((= BTWZ "底部") t) ;标题在底部的时候，rows不翻转(上面是cons拼接的，上面的被拼接到下面去了)
(t (setq Y-KEY (reverse Y-KEY)))
;默认标题在顶部，所以，这里翻转一下(上面是cons拼接的，上面的被拼接到下面去了，翻转后才能到上面去)
)
(SETQ DATA
(MAPCAR (FUNCTION (LAMBDA (A / A-CDR)
(SETQ A-CDR (CDR A))
(VL-SORTA-CDR
(FUNCTION (LAMBDA (E1 E2)
(< (CADR E1) (CADR E2))
)
)
)
)
)
Y-KEY
)
) ;每个X轴排序
(SETQ BTS (CAR DATA))
(MAPCAR
(FUNCTION
(lambda(A)
(MAPCAR (FUNCTION
(LAMBDA (B / tag v)
(setq tag (car b))
(setq
v (vl-some (function (lambda (c)
(if (= (cadr c) (cadr b))
;c的X轴等于B的X轴
(car c) ;返回第一个值
)
)
)
a
)
)
(or v (setq v ""))
(cons tag v)
)
)
BTS
)
)
)
(CDR DATA)
) ;整理数据
)
(setq msg (cdr (assoc "提示语" lst)))
(IF (and PT1 PT2)
()
(PROGN
(setq pts ($shu-biao-tuo-zhuai$ MSG)) ;获取用户鼠标框选的坐标
(SETQ PT1 (CAR PTS))
(SETQ PT2 (LAST PTS))
)
)
(or (and lst
(setq ss (cdr (assoc "选择集" lst)))
(setq entitys (vl-remove-if
(function listp)
(mapcar (function cadr) (ssnamex SS))
)
)
)
(and lst
(setq entitys (cdr (assoc "图元列表" lst)))
)
(and pt1
pt2
(SETQ
SS(ssget "CP"
(2PT->4PT (LIST pt1 pt2))
(LIST (CONS 0 "TEXT,LINE,LWPOLYLINE"))
)
)
(setq entitys (vl-remove-if
(function listp)
(mapcar (function cadr) (ssnamex SS))
)
)
)
)
(setq ss nil)
(setq fz nil)
(setq xts nil)
(mapcar 'set (list 'fz 'xts) ($fen-zu$ entitys)) ;分组
(setq result ($zheng-li$ fz lst));整理
(setq result (mapcar (function (lambda (a) (append a xts))) result))
(setq ss nil)
result
)
感觉你这个简单了，因为代码太短，一般都喜欢长的:lol 具体是做什么用的？ huisguiji 发表于 2024-10-21 15:21
具体是做什么用的？
嗯，楼主太懒了，应该有个动画 APPLOAD 已成功加载 kxbg.lsp。
命令: ; 错误: 输入的字符串有缺陷
大佬，这个应该怎么解决 自贡黄明儒 发表于 2024-10-21 15:02
感觉你这个简单了，因为代码太短，一般都喜欢长的
我有调用cgal的代码，哪个准确率极高，效率低 自贡黄明儒 发表于 2024-10-21 16:25
嗯，楼主太懒了，应该有个动画
如果是倾斜的表格，需要用我的cte功能，cte功能做了很多判断，包括表格里面有合并单元格、倾斜等等
页:
[1]