关于快属性插入点的设置问题，为什么没有用

Taoyimaier

这是我编的一个建立含有属性快的程序，但插入后有两个属性的位置不好，用了那个属性设置也没有用，请分析
(vl-load-com)
(setq acadobj (vlax-get-acad-object))
(setq msobj (vla-get-modelspace (vla-get-activedocument acadobj)))
(setq blksobj (vla-get-blocks (vla-get-activedocument acadobj)))

(defun symj:bld_blk ()
  (setq inspnt (vlax-3d-point '(0 0 0)))
  (setq theblk (vla-add blksobj inspnt "Taoyi1"))
  (setq pnt1 (vlax-3d-point '(-1.5 0 0)))
  (setq pnt2 (vlax-3d-point '(1.5 0 0)))
  (setq theline_ (vla-addline theblk pnt1 pnt2))
  (setq        theuse_        (vla-addattribute
                  theblk
                  1
                  acattributemodepreset
                  "用途"
                  (vlax-3d-point '(0 0 0))
                  "theuse"
                  "住宅"
                )
  )
  (vla-put-alignment theuse_ acAlignmentBottomCenter)

  (setq        thearea_ (vla-addattribute
                   theblk
                   0.4
                   acattributemodepreset
                   "面积"
                   (vlax-3d-point '(0 -1.5 0))
                   "thearea"
                   ""
                 )
  )
  (vla-put-alignment thearea_ acAlignmentTopCenter)


  (setq        theno_ (vla-addattribute
                 theblk
                 0.4
                 acattributemodepreset
                 "室号"
                 (vlax-3d-point '(-100 0 0)) ;;;这一行改了插入点吗，为什么
                 "theno"                     ;;;没有用啊
                 ""
               )
  )
  (vla-put-alignment theno_ acAlignmentmiddleright)

  (setq        thefloor_ (vla-addattribute
                    theblk
                    0.4
                    acattributemodepreset
                    "层次"
                    (vlax-3d-point '(100 0 0)) ;;;这里也是的
                    "thefloor"
                    ""
                  )
  )
  (vla-put-alignment thefloor_ acAlignmentmiddleLeft)
)

myfreemind

Sub gc202()

Dim pp As AcadPoint

Dim bkobj As AcadBlockReference
Dim pnt(0 To 2) As Double
Dim tkins As Variant
Dim entity As AcadEntity
For Each entity In ThisDrawing.ModelSpace
If entity.ObjectName = "AcDbPoint" Then
tkins = entity.Coordinates
End If
Set bkobj = ThisDrawing.ModelSpace.InsertBlock(pnt, "gc202.dwg", 1, 1, 1, 0)
bkobj.InsertionPoint = tkins
Next

End Sub

这个程序的主要功能就是在CAD中所有的点上插入一个gc202块，插入点坐标就是图中各个点的坐标~~~试用一下吧，希望可以帮到你~

Taoyimaier

你的程序我知道了，你的实在mspace中插入图块，而我的程序（目的）是要创建一个图块，这个图块中有属性（基本上就是acadtext）这个实体，而我现在碰到的问题是图块中属性的位置控制不了，都挤在一块了，不美观，谢谢你啦
你可以试着写一个造块的程学(vba)，用objblk.addattribute .....
看能不能控制属性的位置

myfreemind

mccad

http://www.mjtd.com/a2/list.asp?id=382

taoyimaier

不解问题所在

Taoyimaier

刚才可能有些问题，上传失败了，i try again

gjliang

Sub lhjc()
Dim blockA00 As String
Dim insertpoint As Variant
ThisDrawing.ActiveTextStyle.BigFontFile = "D:\Program Files\AutoCAD 2002\Fonts\Hztxtg.shx"
ThisDrawing.ActiveTextStyle.fontFile = "D:\Program Files\AutoCAD 2002\Fonts\italic.shx"
On Error Resume Next
insertpoint = ThisDrawing.Utility.GetPoint(, "请输入插入点：")
blockA00 = "D:\Program Files\AutoCAD 2002\design\att\tukuang\A00.dwg"
If Err Then
Err.Clear
Exit Sub
End If
Dim blockobjA00 As AcadBlockReference
Set blockobjA00 = ThisDrawing.ModelSpace.InsertBlock(insertpoint, blockA00, 1, 1, 1, 0)
ThisDrawing.SendCommand "attedit" & vbCrLf & "(entlast)" & vbCr
If blockobjA00.Layer = "图幅" Then
Exit Sub
Else:
Set tukuang = ThisDrawing.Layers.Add("图幅")
blockobjA00.Layer = "图幅"
End If
ZoomAll
End Sub
我的是先做个属性块，然后插入它，并调用ate命令来修改，根据我的经验，属性块中属性文字的位置和文字添加时或修改时的先后顺序有关。

Taoyimaier

你的代码是插入一个外部参照文件（块），这样的话不安全，如果这个参照文件不见了呢，我想用程序建造一个块，碰到的问题是不能控制其块中属性的插入点，因此当我使用这个生成的块时，属性都挤在一块，难看，我想用vba也许么有这个问题，但我这个综合程序的其他代码都是vlisp写得，不像为这个函数换语言，如果你能用vlisp给我答案，那就太好了，不过，仍然谢谢你，

efan2000

一种是在生成属性时，如用AddAttribute方法时指定插入点。
另一种是在插入块到图纸中后，更改属性引用（注：这时是AttributeRef对象，而不是块中的Attribute对象）的插入点。但更好的方法是更改了对齐方式后再重新设置它的对齐点。
注意：对齐点是跟对齐方式联系在一起的，它的初始位置是在坐标原点，因而有时更改了对齐方式后，会出现“消失”，其实是在原点。