将块属性插入te

ordengate · 发表于 2022-7-6 10:23:43

我试图获取一个具有属性的块，并用多行文字文本字段“标记”它，以与eattext命令一起使用。我一辈子都不知道该怎么做。谁能给我一些指点吗？

当您有100个块并且必须手动在旁边插入文本字段时，它就会变旧。

BIGAL · 发表于 2022-7-6 10:30:25

从块中提取属性值并将其写入多行文字是没有问题的，在这里搜索最近的问题“获取第四个属性”Lee mac和AlanJT在这里发布了一些广泛的块例程，我发布了一个使用VBA多次获取属性的示例解算。

听起来你没有先搜索。

alanjt · 发表于 2022-7-6 10:41:29

可悲的是，很少有人这样做。

fixo · 发表于 2022-7-6 10:46:59

欢迎加入！
试试这个简单的例子

copy

 
(vl-load-com)
(defun C:MField(/ acsp atts blk_obj ent found id pt tag)
 (while (setq ent (entsel "\nSelect block instance (or press Enter to Exit): "))
   (setq blk_obj (vlax-ename->vla-object (car ent)))
   (setq tag (getstring "\nEnter tag <MODIF_A> : "));<--change on appropriate tag here
   (if (eq (chr 0) tag)
     (setq tag "MODIF_A"));<--change on appropriate tag here
   (setq atts (vlax-invoke blk_obj 'getattributes))
   (foreach att atts
     (if (eq (vla-get-tagstring att) tag)
(progn
(setq found (vla-get-textstring att))
(setq id (vla-get-objectid att))
       (setq pt (getpoint "\nPick a  field location >> "))
       (setq acsp (vla-get-block
  (vla-get-activelayout
    (vla-get-activedocument
      (vlax-get-acad-object))))
  )
  (vlax-invoke-method acsp 'addmtext (vlax-3d-point pt) 0.0
  (strcat  "%<[url="file://acobjprop/"]\\AcObjProp[/url] Object(%<[url="file://_objid/"]\\_ObjId[/url] " (itoa id) ">%).TextString [url="file://f/"]\\f[/url] "%tc4">%"));<--"%tc4" is title case, you can remove it
   )
)
     )
   )
 (princ)
 )

~'J'~

ordengate · 发表于 2022-7-6 10:51:04

我曾尝试将该位添加到您之前提供的代码中，但它仍然将对正点放在左上角。我最终会想抵消文本。我最初的代码如下：

copy

 
(setq inspt (vla-get-insertionpoint mtxtobj))
(vla-put-attachmentpoint mtxtobj acAttachmentPointMiddleCenter)
(vla-put-insertionpoint mtxtobj inspt)

这是我可以对插入点做的事情吗？

ordengate · 发表于 2022-7-6 10:55:44

对不起，我有点忙
此代码在我的机器上运行良好（我使用了2009）
再试一次

copy

(DEFUN MTTL ()
(SETVAR "CMDECHO" 0)
(SETQ SCALE (/ 1 (GETVAR "CANNOSCALEVALUE")))
(SETQ MTPOINT (GETPOINT "\NENTER JUSTIFICATION POINT: "))
(SETQ MTHEIGHT (* SCALE 0.078125))
(SETQ MTX (+ (CAR MTPOINT) (* SCALE 0.03125)))
(SETQ MTY (- (CADR MTPOINT) (* SCALE 0.0390625)))
(COMMAND "MTEXT" (LIST MTX MTY) "J" "TL" "H" MTHEIGHT "R" "0" "W" "0" V:TEXT "")
(SETVAR "CMDECHO" 1)
)

fixo · 发表于 2022-7-6 11:00:47

fixo · 发表于 2022-7-6 11:07:09

After you've changed the Attachment point property of mtext object, you
need to put insertion point back:

copy

 (setq inspt (vla-get-insertionpoint mtxtobj))(vla-put-attachmentpoint mtxtobj acAttachmentPointMiddleCenter)(vla-put-insertionpoint mtxtobj inspt)

~'J'~

ordengate · 发表于 2022-7-6 11:12:14

I've tried adding that bit to the code you gave me previously, but it's still putting the justification point at the top left. I'm eventually going to want to offset the text as well. My original code to do that was as follows:

copy

(DEFUN MTTL ()(SETVAR "CMDECHO" 0)(SETQ SCALE (/ 1 (GETVAR "CANNOSCALEVALUE")))(SETQ MTPOINT (GETPOINT "\NENTER JUSTIFICATION POINT: "))(SETQ MTHEIGHT (* SCALE 0.078125))(SETQ MTX (+ (CAR MTPOINT) (* SCALE 0.03125)))(SETQ MTY (- (CADR MTPOINT) (* SCALE 0.0390625)))(COMMAND "MTEXT" (LIST MTX MTY) "J" "TL" "H" MTHEIGHT "R" "0" "W" "0" V:TEXT "")(SETVAR "CMDECHO" 1))

Is this something I can do to the insertion point?

fixo · 发表于 2022-7-6 11:22:38

Sorry, I was a bit busy with my own
This code is working good on my machine (I used A2009)
Try again

[code] (vl-load-com)(defun C:MField(/ acsp atts blk_obj ent found id pt tag) (while (setq ent (entsel "\nSelect block instance (or press Enter to Exit): ")) (setq blk_obj (vlax-ename->vla-object (car ent))) (setq tag (getstring "\nEnter tag : "));

[编程交流] 将块属性插入te

发表回复

精选推荐