如何提取动态块中的查询参数并标注在图框旁边？

守仁格竹GM

回的人少，我来小顶一下

xdcad890

会是我要的东西吗？

dnbcgrass

;我贴一个
(defun c:test()
     (vl-load-com)
     (if (= (setq wzgd (getreal "\n注记文字高度<500>=")) nil)
         (setq wzgd 500)
     )
     (while (setq ent (car (entsel "\n选取动态块:")))
         (progn
              (setq obj (vlax-ename->vla-object ent))
              (vlax-invoke-method obj "GetBoundingBox" 'pmin 'pmax)
              (setq pmin (vlax-safearray->list pmin))
              (setq pmax (vlax-safearray->list pmax))
              (setq dxy (mapcar '- pmax pmin))
              (setq inPt (vlax-get obj "InsertionPoint"))
              (setq pt1 (mapcar '+ inpt (mapcar '* dxy '(0.5 1.0)) (list -300 (+ 100 (* 0.5 wzgd)))))
              (setq pt2 (mapcar '+ pt1 (list 0 (+ wzgd 250))))
              (setq arr (vlax-invoke-method obj "GetDynamicBlockProperties"))
              (setq jgz (vlax-safearray->list (vlax-variant-value arr)))
              (setq csb (mapcar '(lambda(objp)
                                      (vlax-dump-Object objp)
                                      (setq name (vlax-get-property objp "PropertyName"))
                                      (setq valu (vlax-variant-value
                                                       (vlax-get-property objp "Value")
                                                 )
                                       )
                                       (if (= (type valu) 'safearray)
                                           (setq valu (vlax-safearray->list valu))
                                       )
                                       (list name valu)
                                 )
                                 jgz
                          )
              )
              (setq zfc1 (strcat "图纸尺寸: "
                                 (vl-princ-to-string (/ (cadr (assoc "X向距离" csb)) 100))
                                 "×"
                                 (vl-princ-to-string (/ (cadr (assoc "Y向距离" csb)) 100))
                        )
             )
             (setq zfc2 (strcat "规    格: "  (cadr (assoc "图纸尺寸" csb))))
             (command "_text" pt1 wzgd 0 zfc2)
             (command "_text" pt2 wzgd 0 zfc1)
         )
     )
     (princ)
)

ljfzx

dnbcgrass 发表于 2018-4-20 23:49
;我贴一个
(defun c:test()
     (vl-load-com)

挺好的，可以改成能够框选选择多个的吗？如果可以自己选择字体的字形和图层最好了

dnbcgrass

;另贴一个框选的
(defun c:test1()
     (vl-load-com)
     (setq AcadDoc (vla-get-ActiveDocument (vlax-get-acad-object)))

     (if (= (setq wzgd (getreal "\n注记文字高度<500>=")) nil)
         (setq wzgd 500)
     )

     (if (progn
             (princ "\n选取图框动态块:")
             (setq ssa (ssget '((0 . "insert"))))
         )
         (progn
             (vlax-for obj (vla-get-ActiveSelectionSet AcadDoc)
                 (setq arr (vl-catch-all-apply 'vlax-invoke-method (list obj "GetDynamicBlockProperties")))
                 (if (not (vl-catch-all-error-p arr))
                     (progn
                          (vlax-invoke-method obj "GetBoundingBox" 'pmin 'pmax)
                          (setq pmin (vlax-safearray->list pmin))
                          (setq pmax (vlax-safearray->list pmax))
                          (setq dxy (mapcar '- pmax pmin))
                          (setq inPt (vlax-get obj "InsertionPoint"))
                          (setq pt1 (mapcar '+ inpt (mapcar '* dxy '(0.5 1.0)) (list -300 (+ 100 (* 0.5 wzgd)))))
                          (setq pt2 (mapcar '+ pt1 (list 0 (+ wzgd 250))))
                 
                          (setq jgz (vlax-safearray->list (vlax-variant-value arr)))
                          (setq csb (mapcar '(lambda(objp)
                                                 (setq name (vlax-get-property objp "PropertyName"))
                                                 (setq valu (vlax-variant-value
                                                                  (vlax-get-property objp "Value")
                                                             )
                                                 )
                                                 (if (= (type valu) 'safearray)
                                                     (setq valu (vlax-safearray->list valu))
                                                 )
                                                 (list name valu)
                                             )
                                             jgz
                                   )
                         )
                         (setq zfc1 (strcat "图纸尺寸: "
                                            (vl-princ-to-string (/ (cadr (assoc "X向距离" csb)) 100))
                                            "×"
                                            (vl-princ-to-string (/ (cadr (assoc "Y向距离" csb)) 100))
                                     )
                         )
                         (setq zfc2 (strcat "规    格: "  (cadr (assoc "图纸尺寸" csb))))
                         (setq TObj (vla-AddText (vla-get-ModelSpace AcadDoc)
                                                 zfc2
                                                 (vlax-3d-point pt1)
                                                 wzgd
                                    )
                         )
                         ;(vlax-put-property TObj "Layer" tcm) ;设置图层，变量tcm保存所需的图层名，例如(setq tcm "图层1000")，程序运行前确保已经建立了名为"图层1000"的层
                         ;(vlax-put-property TObj "StyleName" ztm) ;设置字体样式名，变量ztm保存所需的样式名，例如(setq ztm "stz0.9")，程序运行前确保已经建立了名为"stz0.9"的字体样式


                         (setq TObj (vla-AddText (vla-get-ModelSpace AcadDoc)
                                                 zfc1
                                                 (vlax-3d-point pt2)
                                                 wzgd
                                    )
                         )
                         ;(vlax-put-property TObj "Layer" tcm) ;设置图层，变量tcm保存所需的图层名，例如(setq tcm "图层1000")，程序运行前确保已经建立了名为"图层1000"的层
                         ;(vlax-put-property TObj "StyleName" ztm) ;设置字体样式名，变量ztm保存所需的样式名，例如(setq ztm "stz0.9")，程序运行前确保已经建立了名为"stz0.9"的字体样式
                     )
                 )
             )
         )
     )

     (vlax-release-object AcadDoc)
     (setq AcadDoc nil)
     (princ)
)

asdf1599

其实不用LISP程序那么复杂，在动态块里面增加一个可见性的参数，在选择图幅时，显示对应的图幅尺寸文字。附件的图框文件可以参考。

asdf1599

我现在在想，如何动态的显示出图比例。比如我们一般按1：100将图框做成块，如果块的比例是1，那么出图比例就是1:100，如果图框的比例是1.5，那么出图比例就是1:150，现在还没有想出好的办法，请各位大神想想，出出主意。

asdf1599

我现在在想，如何动态的显示图框规格的同时，显示出图比例，显示如：图幅A2，比例1:150。比如我们一般按1：100将图框做成块，如果块的比例是1，那么出图比例就是1:100，如果图框的比例是1.5，那么出图比例就是1:150，现在还没有想出好的办法，请各位大神想想，出出主意。