块属性提取，批量标注
我想实现这么一个功能，框选一堆含属性的块， 然后自动把块属性取出来标记在这些块的附近，（分别引一条直线（水平或竖直，平行引出），并在块附近按照坐标的大小排序标上1，2，3，...等等），每个块属性属性的前面也标上对应的1，2，3，...。大概是这个3个步骤，请高手帮忙编写一下，另外大概需要多少米？http://bbs.mjtd.com/xwb/images/bgimg/icon_logo.png 该贴已经同步到 fxfeng的微博 ll_j 发表于 2016-2-2 17:25
好久不写了，针对你的图凑了一个，没做出错处理，也没仔细检查，供参考吧。
误: no function definition: :STR 大神这个是怎么回事呢 学习学习后面找找应用场景看看 学习学习后面找找应用场景看看 目测三楼之类必出源码 哪我占二楼 报价500米，时间1-2天。QQ974636923 题目不清不楚，难怪没人肯写。
1. 块可以有多个属性，是按属性标注，还是按块标注？如果是多属性块，是每个块的属性分别按序标注，还是总体标注？
2. 平面坐标有二维，是按x排序，还是按y排序，还是按x＋y排序，或者按其它规则排序？
画出一张样图，别人才好动手，这样不清不楚，本是两斗米的事情，五斗米也不会有人折腰的。 本帖最后由 fxfeng 于 2016-2-2 13:38 编辑
ll_j 发表于 2016-2-2 10:32 static/image/common/back.gif
题目不清不楚，难怪没人肯写。
1. 块可以有多个属性，是按属性标注，还是按块标注？如果是多属性块，是每个 ...
sorry,通过高手的指点，我自己也在努力，现在实现了一部分，确实因为刚开始学，问题描述的不清不楚，我把要实现的效果图发上来，还望各位高手不吝赐教！（序号是需要自己加的（通过x+y排序加上去），序号右侧的文字是从块属性中取出来的，每个块中各有这两个属性）(省略号是指3，4，5，6，7，8号块的属性（因为现在手工标故省略了）)
（领导也不批，没米，只能自己刻苦钻研了）求教高手！ fxfeng 发表于 2016-2-2 13:32 static/image/common/back.gif
sorry,通过高手的指点，我自己也在努力，现在实现了一部分，确实因为刚开始学，问题描述的不清不楚，我把 ...
好久不写了，针对你的图凑了一个，没做出错处理，也没仔细检查，供参考吧。
(defun mktext(:str :pt10 :j72 / :sty);写文字;(setq :pt10(trans :pt10 1 0))
(entmake
(list
'(0 . "TEXT")
(cons 1 :str)
(cons 10 :pt10)
(cons 11 :pt10)
(cons 7 (setq :sty(getvar "textstyle")))
(cons 40 (getvar "textsize"))
(cons 41 (cdr (assoc 41 (tblsearch "style" :sty))))
(cons 51 (cdr (assoc 50 (tblsearch "style" :sty))))
'(71 . 0)
(cons 72 :j72)
)
)
)
(defun mkline(pt1 pt2)
(entmake
(list
'(0 . "LINE")
(cons 10 pt1)
(cons 11 pt2)
)
)
)
(defun c:tt()
(princ "\n标注属性程序，适用于...")
(princ "\n选择属性块: ")
(setq ss0 (ssget '((0 . "INSERT") (66 . 1)))
len (sslength ss0)
i -1
s0 nil
)
(repeat len
(setq i (1+ i)
en(ssname ss0 i)
s0(cons en s0)
)
)
(setq pt (getpoint "\n标注基点: "))
(setq s0 (vl-sort s0 '(lambda(x y) (< (cadr (assoc 10 (entget x))) (cadr (assoc 10 (entget y)))))))
(setq x1 (cadr (assoc 10 (entget (car s0))))
x2 (cadr (assoc 10 (entget (last s0))))
x0 (car pt)
y0 (cadr pt)
px0(- x0 (* 2.0 (setq txh (getvar "textsize"))))
)
(if (< x0 x1)
(mkline pt (list x2 y0))
(mkline (list x1 y0) pt)
)
(mkline pt (polar pt (/ pi 2) (setq yh (* (+ len 1) txh 4.0))))
(setq i 0)
(repeat len
(setq i (1+ i))
(tt0 (car s0) i)
(tt1 en i)
(setq s0 (cdr s0))
)
)
(defun tt0(en i)
(setq et (entget en)
; nm (cdr (assoc 2 et))
pti(cdr (assoc 10 et))
xi (car pti)
yi (cadr pti)
ptj(list xi y0)
)
(mkline pti ptj)
(if (< yi y0)
(setq yt (- y0 (* txh 1.5)))
(setq yt (+ y0 (* txh 0.5)))
)
(mktext (itoa i) (list (+ xi (* txh 0.5)) yt) 0)
)
(defun tt1(en i)
(setq ts nil)
(while
(= (cdr (assoc 0 (setq et (entget (setq en (entnext en)))))) "ATTRIB")
(setq txt (cdr (assoc 1 et))
ts (cons txt ts)
)
)
(setq pyi (- (+ y0 yh) (* 2.0 txh) (* 4.0 txh (- i 1)))
pxi (+ x0 (apply 'max (mapcar '(lambda(x) (caadr (textbox (list (cons 1 x))))) ts)) txh)
ptxi(+ x0 (* txh 0.5))
pty1(+ pyi (* txh 0.5))
pty2(- pyi (* txh 1.5))
)
(mkline (list px0 pyi) (list pxi pyi))
(mktext (itoa i) (list (- x0 (* txh 0.5)) pty1) 2)
(mktext (cadr ts) (list ptxi pty1) 0)
(mktext (car ts) (list ptxi pty2) 0)
(princ)
)
ll_j 发表于 2016-2-2 17:25 static/image/common/back.gif
好久不写了，针对你的图凑了一个，没做出错处理，也没仔细检查，供参考吧。
大师啊！我花了半个月时间，在即将完成的时候，您竟然编写好了，让我情何以堪啊。差距就在那！！！只能说无限膜拜！！ 路过瞧瞧 来看看！学习学习！
页:
[1]
2