社区 › Auto Lisp › 标记对象#039；s层使用

harilalmn 发表于 2022-7-6 07:39:28

标记对象#039；s层使用

我想在绘图中标记一些元素的图层。我想过使用MLeader来实现这一点。我用lisp编写了一些代码，但不起作用。我做错了什么？
 
(defun c:ObjLayer(/ pnt1 pnt2 n obj dxf LayerName newdxf)
(setq n 1)
(while (> n 0)
   (setq pnt1 (getpoint "\nPick first point:"))
   (setq pnt2 (getpoint pnt1 "\nPick next point:"))
   (setq obj (car (entsel "\nPick Entity:")))
   (setq dxf (entget obj))
   (setq LayerName (cdr (assoc 8 dxf)))
   (setq newdxf '((0 . "MULTILEADER")
             (cons 110 (car pnt1)(cadr pnt1)(caddr pnt1))
             (cons 10 (car pnt2)(cadr pnt2)(caddr pnt2))
             (cons 304 LayerName)
             (cons 8 "A-ANNO-DIMS")
             ))
   (entmake newdxf)
   (setq n (1+ n))
)
)

Dadgad 发表于 2022-7-6 07:44:54

这远不如您所追求的lisp解决方案那么性感，而且看起来您正在接近您所追求的。毫无疑问，有人会跳进来整理你的Lisp程序，但除此之外，我已经建立了一个多引线样式，其中的文本包括一个字段。如果使用它，需要双击字段，这将打开字段定义框，如图所示。到达后，您可以按下按钮提示选择对象。

Tharwat 发表于 2022-7-6 07:51:14

我的老朋友。。。
 

(defun c:Test (/ spc p1 p2 str lead)
(vl-load-com)
;; Tharwat 08. 07. 2011
(cond ((not acdoc)
      (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
       )
)
(setq spc (if (> (vla-get-activespace acdoc) 0)
             (vla-get-modelspace acdoc)
             (vla-get-paperspace acdoc)
         )
)
(while
   (and
   (setq p1 (getpoint "\n specify First Point :"))
   (setq p2 (getpoint p1 "\n Specify Second point :"))
   (setq str
            (car (entsel "\n Specify any entity to get its Layer name :"))
   )
   )
    (progn
      (setq lead (vla-addmleader
                   spc
                   (vlax-make-variant
                     (vlax-safearray-fill
                     (safearray vlax-vbdouble '(0 . 5))
                     (apply 'append (list p1 p2))
                     )
                   )
                   0
               )
      )
      (vla-put-textstring lead (cdr (assoc 8 (entget str))))
    )
)
(princ)
)

harilalmn 发表于 2022-7-6 07:57:40

杰出的塔尔瓦特。。。，正是我想要的。。。！！！！谢谢。。。！！！

harilalmn 发表于 2022-7-6 07:58:49

我知道这种使用field的方法。但我不想每次都去编辑文本。好吧，谢谢你的支持，爸爸。。。

harilalmn 发表于 2022-7-6 08:05:41

Tharwat，有没有办法控制“着陆距离”属性？

Lee Mac 发表于 2022-7-6 08:09:19

 
(apply 'append (list '(a b c) '(d e f)))=(a b c d e f)=(append '(a b c) '(d e f))

Lee Mac 发表于 2022-7-6 08:13:27

另一个，使用字段：
 

;; Object Layer in MLeader Field-Lee Mac-www.lee-mac.com

(defun c:layerleader ( / _getpoints _objectid acdoc e l )

   (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))

   (setq _getpoints
       (lambda ( / l p )
         (if (car (setq l (list (getpoint "\nFirst Point: "))))
               (while (setq p (getpoint "\nNext Point <Done>: " (car l)))
                   (mapcar
                      '(lambda ( a b ) (grdraw a b 3 1))
                     (setq l (cons p l))
                     (cdr l)
                   )
               )
         )
         (redraw) (reverse l)
       )
   )

   (setq _objectid
       (eval
         (list 'lambda '( obj )
               (if
                   (and
                     (vl-string-search "64" (getenv "PROCESSOR_ARCHITECTURE"))
                     (vlax-method-applicable-p (vla-get-utility acdoc) 'getobjectidstring)
                   )
                   (list 'vla-getobjectidstring (vla-get-utility acdoc) 'obj ':vlax-false)
                  '(itoa (vla-get-objectid obj))
               )
         )
       )
   )

   (if
       (and
         (setq e (car (entsel)))
         (< 1 (length (setq l (_getpoints))))
       )
       (vla-put-textstring
         (vlax-invoke
               (vlax-get-property acdoc (if (= 1 (getvar 'CVPORT)) 'paperspace 'modelspace))
               'addmleader
               (apply 'append l) 0
         )
         (strcat "%<\\AcObjProp Object(%<\\_ObjId " (_objectid (vlax-ename->vla-object e)) ">%).Layer>%")
       )
   )
   (vla-regen acdoc acactiveviewport)
   (princ)
)
(vl-load-com) (princ)

johmmeke 发表于 2022-7-6 08:17:05

嘿Tharwat
 
谢谢你的快速回放。。。
只有我仍然只能选择一个对象。。我做错什么了吗？
格里茨·约翰

Tharwat 发表于 2022-7-6 08:25:19

 
您的意思是要获取选定对象的数量吗？

查看完整版本: 标记对象#039；s层使用