在选定对象之间插入块

Ohnoto · 发表于 2022-7-6 09:27:42

我有一些代码来自一个曾经为我们工作的人，在那里它插入了一个块，其距离值位于两点之间的中点。我希望能够将其调整到默认情况下做相同的事情，但它将块放在基于定位值的分组选择的每个极块之间，类似于此线程，它根据这些值调整数字。。。

http://www.cadtutor.net/forum/showthread.php?58422-属性重新编号&p=395948&viewfull=1#post395948

... 用户不必点击每个极点上的点。

随附的是LISP和DWG块。
EXADO。图纸
EXADO_Main-0001。lsp

Ohnoto · 发表于 2022-7-6 09:33:23

有人能帮忙吗？

Ohnoto · 发表于 2022-7-6 09:35:57

我试着用这个做一些事情，虽然在某些方面是错误的。

copy


(defun c:STADO  (/ adoc i SelSet StrValidate AttVal StaList)
 (vl-load-com)
 (setq adoc (vla-get-activedocument (vlax-get-acad-object))
   i    0)
 (if (ssget ":L" '((0 . "INSERT")(2 . "`*U*,POLE-STA")))
     (cond (
     (vlax-for Sta  (setq SelSet (vla-get-activeselectionset adoc))
(if (and (equal (vla-get-effectivename sta) "pole-sta")
       (/= (setq StrValidate (vla-get-textstring (car (setq AttVal
                    (vlax-invoke
                      Sta
                      'GetAttributes))))) ""))
         (setq StaList
            (cons
              (list StrValidate (nth 26 AttVal))
              StaList))
                 )
        )
     (foreach
         Blk  (vl-sort
                StaList
                (function (lambda (p1 p2) (< (car p1) (car p2)))))
    (setq p1 (vlax-get p1 'insertionpoint))
    (setq p2 (vlax-get p2 'insertionpoint))
        (setq adodist (distance p1 p2))
    (setq adodist (rtos adodist 2 0))
    (setq adomid (mapcar '+ p1 (mapcar '/ (mapcar '- p2 p1) '(2.0 2.0 2.0))))
    (setq adoang (angle p1 p2))     
    (command "-insert" "aerial distance -dyn" adomid "" (angtos adoang) adodist "")
    (cadr Blk) (itoa (setq i (1+ i))))
     )
    )
   (vla-delete SelSet)
)
(princ)
 )

我得到错误“错误的参数类型：VLA-OBJECT nil”。我相信这是在lambda和p1/p2变量编码的底部。

pBe · 发表于 2022-7-6 09:41:53

copy

 
(defun c:STADO  (/ AddOffset adoc SelSet StrValidate AttVal StaList p1 p2 dblk)
(vl-load-com)
[color=blue](defun AddOffset  (lst)[/color]
[color=blue]     (list (+ (car lst) 11.25) (- (cadr lst) 11.0135) 0.0))      [/color]
(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
(if (ssget ":L" '((0 . "INSERT")(2 . "`*U*,POLE-STA")))
(cond (
(vlax-for
      Sta
         (setq SelSet (vla-get-activeselectionset adoc))
     (if (and (equal (vla-get-effectivename sta) "pole-sta")
              (/= (setq StrValidate
                             (vla-get-textstring
                                   (car (setq AttVal
                                                   (vlax-invoke
                                                         Sta
                                                         'GetAttributes)))))
                  ""))
           (setq StaList
                      (cons
                            (list StrValidate (nth 26 AttVal))
                            StaList))
           )
     )
[color=blue](setq StaList[/color]
          (vl-sort
                StaList
                (function (lambda (p1 p2) (< (car p1) (car p2)))))[color=blue])[/color]
[color=blue](while (and (setq p1 (car StaList))[/color]
[color=blue]           (setq p2 (cadr Stalist)))[/color]
     (setq p1     [color=blue](AddOffset (vlax-get (cadr p1) 'insertionpoint))[/color]
           p2     [color=blue](AddOffset (vlax-get (cadr p2) 'insertionpoint))[/color]
           adodist (distance p1 p2)
           adodist (rtos adodist 2 0)
           adomid  [color=blue](mapcar (function (lambda (a b) (/ (+ a b) 2.)))[/color]
                           p1
                           p2)
           adoang  (angle p1 p2))
  [color=blue]  (setq dblk (vlax-invoke[/color]
[color=blue]                      (vlax-get (vla-get-ActiveLayout adoc) 'Block)[/color]
[color=blue]                      'insertblock[/color]
[color=blue]                      adomid[/color]
[color=blue]                      "aerial distance -dyn"[/color]
[color=blue]                      1[/color]
[color=blue]                      1[/color]
[color=blue]                      1[/color]
[color=blue]                      adoang)[/color]
[color=blue]           )[/color]
    [color=blue](vla-put-textstring[/color]
[color=blue]           (car (vlax-invoke dblk 'Getattributes))[/color]
[color=blue]           adodist)[/color]
[color=blue]     (setq Stalist (cdr StaList))[/color]
     )
)
)
(vla-delete Selset)
)
(princ)
)