将数据附着到块创建

John E Green · 发表于 2022-7-6 11:08:50

大家好，

我在这个论坛上有一个由许多位组成的例程，它允许我将多段线转换为具有唯一ID（用户输入）的块，现在我需要做的是在创建每个块时将数据附加到每个块，数据就是区域，实体ID（点符号5）和唯一ID。我可以获得所有信息，但我不知道如何在使用vla insertblock的lisp例程中附加数据。该例程通过从多段线创建块并将其插入原始多段线的中心点来工作，然后删除原始多段线。

任何指点都会很有帮助，并能保留我头发剩下的部分。

谢谢

Lee Mac · 发表于 2022-7-6 11:15:12

嗨，约翰，

您是指填充块属性吗？

John E Green · 发表于 2022-7-6 11:15:25

嗨，李，

是块属性。我不确定是否需要创建具有三个属性的块，然后使用这三个属性将多段线转换为具有唯一名称的块，或者是否可以在创建块后但lisp旋转线结束之前添加属性

希望这有意义。

约翰

Lee Mac · 发表于 2022-7-6 11:20:06

你现在有什么代码？这可能会帮助我更好地理解你的问题。

John E Green · 发表于 2022-7-6 11:21:48

嗨，李，

这是代码，它去它从这个论坛，我做了一些小改动

（定义c：生成空间（/ss adoc pt\U lst center blk*error*bi bname bpat sSpace）
;;;从选定实体生成空间
（setq bpat“空格-”）
（setq sSpace（getstring“\n请输入空间ID.”）
（如果（tblsearch“BLOCK”sSpace）（退出））
（defun*错误*（msg）
（vla ENDUDOMARK adoc）；
（普林斯消息）
（普林斯）
) ;_ defun结束
（vl load com）
（vla startundomark）
（setq adoc（vla get activedocument（vlax get acad object）））
) ;_ vla StartUndoMark结束
（如果（不是）（vl-catch-all-error-p
（vl catch all apply’（λ（）（setq ss（ssget“_：L”）））
) ;_ vl-catch-all-error-p结束
) ;_ not结束
（程序
（setq）
ss（mapcar“vlax ename->vla对象
（vl remove if“listp（mapcar”cadr（ssnamex ss）））
) ;_ mapcar结束
pt\U lst（应用“附加
（地图车
'（λ（x/minp maxp）
（vla getboundingbox x'minp'maxp）
（列表（vlax safearray->list minp）
（vlax safearray->list maxp）
) ;_ 追加结束
) ;_ lambda结束
不锈钢
) ;_ mapcar结束
) ;_ 追加结束
中心（mapcar’（λ（a b）（/（+a b）2））
（列表（应用“min（mapcar”car pt\u lst））
（应用“min（mapcar”cadr pt\U lst））
（应用“min（mapcar”caddr pt\U lst））
) ;_ 列表结束
（列表（应用“max（mapcar）”car pt\U lst）
（应用“max（mapcar”cadr pt\U lst））
（应用“max（mapcar”caddr pt\U lst））
) ;_ 列表结束
) ;_ mapcar结束
B名称
（程序
（setq bi 0）
（setq bName sSpace）
（while（tblsearch“BLOCK”sSpace））
bname）
blk（vla add（vla get blocks adoc）
（vlax-3d-点中心）
B名称
) ;_ vla添加结束
) ;_ setq结束
（vla copyobjects
adoc公司
（vlax make变体
（vlax安全阵列填充
（vlax make safearray vlax vbobject（cons 0（1-（length ss）））
不锈钢
) ;_ vlax安全阵列填充结束
) ;_ vlax make变体结束
黑色
) ;_ vla copyobjects结束
（vla插入块
（vla objectidtoobject adoc（vla get ownerid（car ss）））
（vlax-3d-点中心）
（vla get name blk）
1
1
1
0
) ;_ vla插入块末端
（mapcar’vla擦除ss）
) ;_ 结束和
) ;_ if结束
（vla endundomark adoc）
（普林斯）
) ;_ defun结束

我正在使用的位是vla插入块，我需要在完成后添加thre属性，以便捕获auto cade实体id并添加sSpace id和ployline区域。

希望这有帮助

约翰

Lee Mac · 发表于 2022-7-6 11:24:59

嗨，约翰，

也许这会提供一些想法：

copy


(defun c:MakeSpace ( / *error* BLOCK CEN DOC FLG ID NME OBJS SPC SS )
 (vl-load-com)
 ;; Lee Mac  ~  18.05.10
 (setq id "SPACE-")
 (defun *error* ( msg )
   (and flg (vla-EndUndoMark doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ)
 )
 (setq spc
   (if
     (or
       (eq AcModelSpace
         (vla-get-ActiveSpace
           (setq doc
             (vla-get-ActiveDocument
               (vlax-get-acad-object)
             )
           )
         )
       )
       (eq :vlax-true (vla-get-MSpace doc))
     )
     (vla-get-ModelSpace doc)
     (vla-get-PaperSpace doc)
   )
 )
 (initget 1)
 (setq nme (getstring "\nPlease Enter Space ID: "))
 (cond
   (
     (tblsearch "BLOCK" (strcat id nme))
     (princ "\n** Block Already Exists **")
   )
   (
     (not (setq ss (ssget "_:L")))
   )
   (
     (setq flg (not (vla-StartUndoMark doc)))
     (setq block
       (vla-Add (vla-get-Blocks doc)
         (vlax-3D-point
           (setq cen
             (apply (function mapcar)
               (cons
                 (function
                   (lambda ( x y )
                     (/ (+ x y) 2.)
                   )
                 )
                 (SSBoundingBox ss)
               )
             )
           )
         )
         (strcat id nme)
       )
     )
     (vla-copyObjects doc
       (ObjectVariant (setq objs (ss->vla ss))) block
     )
     (mapcar
       (function
         (lambda ( prmpt pt tag )
           (vla-AddAttribute block (getvar 'TEXTSIZE) 0 prmpt
             (vlax-3D-point pt) tag ""
           )
         )
       )
       (list "Tag 1: " "Tag 2: " "Tag 3: ")
       (list cen
         (polar cen (/ (* 3 pi) 2.) (* 1.5 (getvar 'TEXTSIZE)))
         (polar cen (/ (* 3 pi) 2.) (* 3.0 (getvar 'TEXTSIZE)))
       )
       (list "TAG1" "TAG2" "TAG3")
     )
     (if
       (vl-catch-all-error-p
         (vl-catch-all-apply (function vla-InsertBlock)
           (list spc (vlax-3D-point cen) (strcat id nme) 1. 1. 1. 0.)
         )
       )
       (princ "\n** Error Inserting Block **")
     )
     (mapcar (function vla-erase) objs)
     (setq flg (vla-EndUndoMark doc))
   )
 )
 (princ)
)
(defun ObjectVariant ( lst )
 (vlax-make-variant
   (vlax-safearray-fill
     (vlax-make-safearray vlax-vbObject
       (cons 0 (1- (length lst)))
     )
     lst
   )
 )
)
(defun SSBoundingBox ( ss / ent ll ur bBoxs )
 ;; Lee Mac  ~  18.03.10
 (  (lambda ( i )
      
      (while (setq ent (ssname ss (setq i (1+ i))))
        (vla-getBoundingBox (vlax-ename->vla-object ent) 'll 'ur)
        (setq bBoxs (cons (vlax-safearray->list ur)
                          (cons (vlax-safearray->list ll) bBoxs)))
      )
    )    
 -1
 )
 (mapcar
   (function
     (lambda (operation)
       (apply (function mapcar)
         (cons operation bBoxs)
       )
     )
   )
   '(min max)
 )
)
(defun ss->vla ( ss )
 (if ss
   (
     (lambda ( i / e l )
       (while (setq e (ssname ss (setq i (1+ i))))
         (setq l
           (cons
             (vlax-ename->vla-object e) l
           )
         )
       )
       l
     )
     -1
   )
 )
)

此外，请务必阅读此内容。

李

John E Green · 发表于 2022-7-6 11:29:42

大家好，

我遇到了一些对我来说似乎很奇怪的事情，但我相信对此有一个非常局部的解释。

我已经使用了上面的代码，李善意地张贴这是一个工作的待遇。我现在想填充数据标记，其中之一是我需要成为实体句柄。如果我尝试使用

（setq hHandle（vla get handle block））

我得到了一个奇怪的结果，hHandle是“277”，但如果我使用（entget（entlast））句柄是27A，那么每当最后一个字符出错时都会发生这种情况。例如23E为233，24F为244

我在这里做一些研究，我假设句柄是一个文本字符串而不是十六进制数，我在插入块后放置代码来获取句柄，因为我认为这可能与在插入块之前拾取原始对象句柄有关。

我在这里有点不知所措，不确定这只是一个字符串对话，还是我需要恢复到使用entget来收集信息。

当做
约翰