插入选定的块'；n
我觉得我有点懒。。。现在我觉得我也许可以做这个常规。。。但如果有人解决它会更好。。。
正在选择一组选定的块。。。我想在他们自己的插入点插入他们的名字（使用当前的样式和高度）。
我有两个密码，一个是Alan J。。。另一个来自我。。。但如果我们摆脱了拾取插入点，我们可以自动完成这一切，我认为。。。
有人能帮忙吗？
(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
(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)
)
此外，我还有一个例程的这一部分，用于从选择中过滤块。。
(progn
(prompt "\nSelect all the Blocks to be exported: ")
(setq #SSET (ssget (list (cons 0 "INSERT")))))))
并抓住它们的插入点
(setq #CNT (sslength #SSET)
#IDX 0)
(while (/= #IDX #CNT)
(setq #ENT (entget (ssname #SSET #IDX))
#PT(cdr (assoc 10 #ENT))
但是，如何将这一切混合在一起呢？ 看起来你需要的东西都有了。我建议写一个函数来完成一次，然后写一个函数来创建一个选择集，对于选择集中的每个项目，调用第一个函数。
请记住，可以通过将变量放在函数定义的正斜杠之前，将变量传递给函数，如下所示：
(defun function(passedVar / )
(princ passedVar)
)
然后查看ssnamex函数（可以在LISP帮助菜单中找到），以获取选择集并将其转换为实体名称列表。 这应该给你一些思考的东西。。。
(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
您将需要此接头：
;;; 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
你是根纽斯。。。
该职位无需进一步协助。
很乐意帮忙。 哎呀，忘了考虑动态块。以上更新。
页:
[1]