求解决个错误。。。。请各位老大出手谢谢~
本帖最后由 flytoday 于 2013-4-3 13:32 编辑求解决
; 错误: no function definition: TBC:DXFS
(DEFUN C:tbCount (/ Main Unique fuzz)
(defun Main (/ tmp el SS en enType acme1 acme2 ids1 ids2 lst SSet)
(setq SS (TBC:GetEnts
'((0 . "CIRCLE,INSERT,LINE,LWPOLYLINE,TEXT,MTEXT"))
)
SSet (ssadd)
fuzz 0.01 ;指定位置坐标点的误差
)
(foreach el SS
(setq en (entget el)
enType (TBC:DXF 0 en)
acme1nil
acme2nil
)
(cond ((= enType "CIRCLE")
(setq ids1 '(0 40)
ids2 '(10)
)
)
((= enType "INSERT")
(setq ids1 '(0 2 41 42 43 44 45 50 66 70 71)
ids2 '(10)
)
)
((= enType "LINE")
(setq ids1 '(0)
ids2 '(10 11)
)
)
((= enType "LWPOLYLINE")
(setq ids1 '(0 43 70 90)
ids2 '()
acme1 '(40 41 42)
acme2 '(10)
)
)
((= enType "TEXT")
(setq ids1 '(0 1 7 40 50 51 71 72 73)
ids2 '(10 11)
)
)
((= enType "MTEXT")
(setq ids1 '(0 1 7 40 41 42 43 44 50 71 72 73)
ids2 '(10 11)
)
)
)
(setq ids1 (TBC:DXFS ids1 en)
ids1 (append ids1 (mapcar '(lambda (x) (TBC:mDXF x en)) acme1))
ids2 (TBC:DXFS ids2 en)
ids2 (append ids2 (mapcar '(lambda (x) (TBC:mDXF x en)) acme2))
tmp (list ids1 ids2)
)
(if (Unique tmp lst)
(setq SSet (ssadd el SSet)
lst(append lst (list tmp))
)
)
)
(sssetfirst nil SSet)
(TBC:Command '("regen") nil)
(princ)
)
(defun Unique (el lst / a b)
(setq a (car el)
b (cadr el)
)
(if lst
(vl-every
'(lambda (x)
(not (and (equal a (car x)) (equal b (cadr x) fuzz)))
)
lst
)
T
)
)
(Main)
)
;选择指定过滤条件的实体名表
(defun TBC:GetEnts (filter / i n SSET enName RSET)
(setq SSET (ssget filter)
n (if SSET
(sslength SSET)
0
)
i 0
)
(while (< i n)
(setq enName (ssname SSET i)
RSET (cons enName RSET)
i (1+ i)
)
)
(reverse RSET)
)
;取出表中的元素值
(defun TBC:DXF (code lst)
(cdr (assoc code lst))
)
;取出表中的同一代码的多个元素值
(defun TBC:mDXF (code en / tmp i lst)
(setq i 0)
(while (setq i (TBC:FindAt code en i))
(setq tmp (cdr (nth i en))
i (1+ i)
lst (append lst (list tmp))
)
)
lst
)
;执行Command函数
(defun TBC:Command (paralist varlist / tmp i n el oldvar)
(setq varlist (append varlist (list (list "CMDECHO" 0)))
n (length varlist)
i 0
)
(while (< i n)
(setq el (nth i varlist)
tmp (list (getvar (car el)))
oldvar (append oldvar tmp)
i (1+ i)
)
(setvar (car el) (cadr el))
)
(foreach el paralist (command el))
(setq i 0)
(while (< i n)
(setq el(nth i varlist)
tmp (nth i oldvar)
i (1+ i)
)
(setvar (car el) tmp)
))
(defun TBC:DXFS (code lst)
(cdr (assoc code lst))
)
或者
(defun TBC:DXFS (code lst)
(cdr (assoc code (ENTGET LST)))
)
一个个加载上试试 试试加上这两个函数试试吧：
(defun TBC:DXFS (ids en)
(vl-remove nil (mapcar '(lambda (x) (assoc x en)) ids))
)
(defun TBC:FindAt (code en i)
(repeat i
(setq en (cdr en))
)
(if (setq a (assoc code en))
(+ i (VL-POSITION a en))
)
)
本帖最后由 flytoday 于 2013-4-3 18:45 编辑
顾哥还有哪位高手能不能将选择到重叠的那个删除了啊~~~~~~~~~~~~~~~~~~~~~~~~~ 统计图元个数（位置相同的同种重叠图元只计一个），并删除重叠的园元留下一个。。。
想达到这个效果。。请各位老大出手帮帮忙谢了。。。
页:
[1]