插入选定的块'；n

gilsoto13 · 发表于 2022-7-6 12:26:50

我觉得我有点懒。。。

现在我觉得我也许可以做这个常规。。。但如果有人解决它会更好。。。

正在选择一组选定的块。。。我想在他们自己的插入点插入他们的名字（使用当前的样式和高度）。

我有两个密码，一个是Alan J。。。另一个来自我。。。但如果我们摆脱了拾取插入点，我们可以自动完成这一切，我认为。。。

有人能帮忙吗？

copy

(defun c:BlockName (/ #Ent #Point)
 (and
   (setq #Ent (car (entsel "\nSpecify block: ")))
   (eq "INSERT" (cdr (assoc 0 (entget #Ent))))
   (setq #Point (getpoint "\nSpecify placement point for MText: "))
   (entmake (list
              '(0 . "MTEXT")
              '(100 . "AcDbEntity")
              '(100 . "AcDbMText")
              (cons 7 (getvar "textstyle"))
              (cons 10 (trans #Point 1 0))
              (cons 1 (cdr (assoc 2 (entget #Ent))))
            ) ;_ list
   ) ;_ entmake
 ) ;_ and
 (princ)
) ;_ defun

copy


(defun c:bn () 
(setq obj (car (entsel "\nPick Block..."))) 
(setq bname (cdr (assoc 2 (entget obj))))
(setq txt (strcat "" bname ""))
(setq p1 (getpoint "\nPick text location: "))
(command "text" p1 "" "" (strcat "" bname "") )
(command "change" "l" "" "" "" "" "" "" txt)
)

此外，我还有一个例程的这一部分，用于从选择中过滤块。。

copy


   (progn
     (prompt "\nSelect all the Blocks to be exported: ")
     (setq #SSET (ssget (list (cons 0 "INSERT")))))))

并抓住它们的插入点

copy


     (setq #CNT (sslength #SSET)
           #IDX 0)
     (while (/= #IDX #CNT)
       (setq #ENT (entget (ssname #SSET #IDX))
             #PT  (cdr (assoc 10 #ENT))

但是，如何将这一切混合在一起呢？

Freerefill · 发表于 2022-7-6 12:42:09

看起来你需要的东西都有了。我建议写一个函数来完成一次，然后写一个函数来创建一个选择集，对于选择集中的每个项目，调用第一个函数。

请记住，可以通过将变量放在函数定义的正斜杠之前，将变量传递给函数，如下所示：

copy


(defun function(passedVar / )
(princ passedVar)
)

然后查看ssnamex函数（可以在LISP帮助菜单中找到），以获取选择集并将其转换为实体名称列表。

alanjt · 发表于 2022-7-6 12:53:49

这应该给你一些思考的东西。。。

copy

(defun c:BlockNames (/ #SS)
 (cond
   ((setq #SS (ssget '((0 . "INSERT"))))
    (or *AcadDoc*
        (setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ or
    (vlax-for x (setq #SS (vla-get-activeselectionset *AcadDoc*))
      (AT:Mtext (vla-get-insertionpoint x)
                (if (vlax-property-available-p x 'EffectiveName)
                  (vla-get-effectivename x)
                  (vla-get-name x)
                ) ;_ if
                0
                (vla-get-layer x)
                5
      ) ;_ AT:Mtext
    ) ;_ vlax-for
    (vla-delete #SS)
   )
 ) ;_ cond
 (princ)
) ;_ defun

您将需要此接头：

copy

;;; Add MText to drawing
;;; #InsertionPoint - MText insertion point
;;; #String - String to place in created MText object
;;; #Width - Width of MText object (if nil, will be 0 width)
;;; #Layer - Layer to place Mtext object on (nil for current)
;;; #Justification - Justification # for Mtext object
;;;             1 or nil= TopLeft
;;;             2= TopCenter
;;;             3= TopRight
;;;             4= MiddleLeft
;;;             5= MiddleCenter
;;;             6= MiddleRight
;;;             7= BottomLeft
;;;             8= BottomCenter
;;;             9= BottomRight
;;; Alan J. Thompson, 05.23.09
(defun AT:MText (#InsertionPoint #String #Width #Layer #Justification / #Width
                #Space #Insertion #Object
               )
 (or #Width (setq #Width 0))
 (or *AcadDoc*
     (setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object)))
 ) ;_ or
 (setq #Space     (if (or (eq acmodelspace
                              (vla-get-activespace *AcadDoc*)
                          ) ;_ eq
                          (eq :vlax-true (vla-get-mspace *AcadDoc*))
                      ) ;_ or
                    (vla-get-modelspace *AcadDoc*)
                    (vla-get-paperspace *AcadDoc*)
                  ) ;_ if
       #Insertion (cond
                    ((vl-consp #InsertionPoint) (vlax-3d-point #InsertionPoint))
                    ((eq (type #InsertionPoint) 'variant) #InsertionPoint)
                    (T nil)
                  ) ;_ cond
 ) ;_ setq
 ;; create MText object
 (setq #Object (vla-addmtext #Space #Insertion #Width #String))
 ;; change layer, if applicable
 (and #Layer
      (tblsearch "layer" #Layer)
      (vla-put-layer #Object #Layer)
 ) ;_ and
 ;; change justification & match insertion point with new justification
 (cond ((member #Justification (list 1 2 3 4 5 6 7 8 9))
        (vla-put-attachmentpoint #Object #Justification)
        (vla-move #Object
                  (vla-get-InsertionPoint #Object)
                  #Insertion
        ) ;_ vla-move
       )
 ) ;_ cond
 #Object
) ;_ defun