帮忙分析：让块属性的文本在超出一个固定长度时缩小

gare1000

代码如下：为什么不可以实现。我的意思是使用一个带有属性的块，在定义属性的时候我把属性的标记规定为该属性的文本的最大长度，例如一个属性125表示文本长度是125，当长度超过的时候，我想改变属性的文字宽高比来缩小文字。大家看看，下面的代码为什么没有反应，不会改。 (defun C:selblk( / ss1 b1 )
(setq Ss1 (ssadd (car (entsel))))
(setq b1 (ssname ss1 0))

(EditBlockAtt b1)
) ; 编辑块里的属性.
(Defun EditBlockAtt (Block1 / EntName LOOP Attlist
AttBox p1 p2 AttLen AttValue AttTag
AttNewList
)
(setq EntName Block1)
(setq EntName (entnext EntName))

(setq LOOP T)
(While (and EntName LOOP)
(setq Attlist (entget EntName))
(if (= (cdr (assoc 0 Attlist)) "ATTRIB")
(progn

(setq AttBox (textbox Attlist)) ;属性的左下及右上角点坐标.
(setq p1 (Point_3d->2d (nth 0 AttBox ))
p2 (Point_3d->2d (nth 1 AttBox ))
)
(setq AttLen (- (nth 0 p2) (nth 0 p1))) ;得到属性的实际长度.
;(setq AttValue ((cdr (assoc 1 Attlist))))
(setq AttTag (/ (atof (cdr (assoc 2 Attlist))) 5.0)) ;得到属性标记，并转换为该属性允许的最大距离.（除以5。0 是因为我定义属性时定大了5倍）
(setq OldScale (cdr (assoc 41 Attlist)) ) ; 得到老的比例.
(if (> AttLen AttTag)
(progn
(setq NewScale (* (/ OldScale AttLen) AttTag)) ;得到新的比例.
(setq AttNewList (subst (cons 41 NewScale) (assoc 41 Attlist) Attlist))
(entmod AttNewList)
(entupd (cdr (assoc -1 AttNewList)))
)
)
)
(setq LOOP nil)
)
(setq EntName (EntNext EntName))
)


(princ)
)

meflying

为什么给图片不给DWG图？

无痕

属性文字用fit不就行了？

gare1000

明天船图了，用fit 的话，当文字很少时，每个字符都会很肥，不好看。

无痕

那就：当string超过某一长度（字数），就改小，或则改成fit方式。

Ea

entupd 后可以吗？不过处理属性还是用Vlisp顺手

gare1000

Ea发表于2004-6-17 23:53:00entupd 后可以吗？不过处理属性还是用Vlisp顺手

entupd 难道不是lisp吗？ 今天早上又试了一下，可以了，只是不会更新，我用了一条(command "redraw" "") 就好了，可是我已经用了entupd 命令了，难道entupd不起作用吗？

meflying

程序怎么不给全？ 我加了个函数 (defun Point_3d->2d(pt)
(reverse (cdr (reverse pt)))
) 结果没问题啊，能自动更新。。。

gare1000

不好意思，漏了Point_3d->2d ，就是把（x y z )------>(x y)的形式。 (defun Point_3d->2d (3dpt)
(list (car 3dpt) (cadr 3dpt))
)

gare1000

是呀，今早我也发现了可以，可是昨晚怎么就不行呢？真奇怪，也许是因为我的cad运行了一天，要重新启动。


你这个屏幕录象的是什么软件做的，是豪杰吗？