brainstorm 发表于 2017-7-31 17:54:45

重命名块对话框版,支持放大到指定块


(defun c:renblk        (/ INSERTNAME SEL filllist)
(setq objlst nil)
(vlax-for n
              (zgx:acsssets)
    (vla-delete n)
)
(setq sel (zgx-select "select insert" '((0 . "insert"))))
(vlax-for each sel
    (setq insertname (vla-get-name each))
    (if        (not (member insertname filllist))
      (progn
        (setq filllist (append filllist (list insertname))
              objlst   (append objlst (list each))
        )
      )
    )
)
(setq        filllist (mapcar '(lambda (x)
                          (list x
                                  x
                          )
                          )
                       filllist
               )

)
(vlax-for each sel
    (vlax-release-object each)
)
(vla-delete sel)
(vlax-release-object sel)
(dcl-project-load "room_finishing" t)
(dcl-form-show room_finishing/renblk)
(dcl-grid-filllist room_finishing/renblk/grid1 filllist)
(dcl-Control-SetColumnStyleList
    ROOM_finishing/renblk/Grid1
    '(0 6)
)
(gc)
)

完整代码间附件


brainstorm 发表于 2017-7-31 18:02:03

漏掉一个函数
;;;---获得grid指定单元格值-----------------------------------------------------------------------------
;;;---startcell '(0 0)-, 取出全部----------------------------------------------------------------------
;;;---(get_grid_value '(2 nil) '(nil nil),取出第二项开始所有单元格值---------------------------------
(defun get_grid_value (gridname          startcellendcell        /
                     row          column   rtn        rtn1
                     startrow          startcolumn                endrow
                     n          endcolumn
                      )
(setq        row    (dcl-grid-getrowcount gridname)
        column (dcl-grid-getcolumncount gridname)
)
(if (not startcell)
    (setq startcell '(0 0))
)
(if (not endcell)
    (setq endcell (list (- row 1) (- column 1)))
)
(setq        startcell
       (mapcar '(lambda (a b)
                  (if        (not a)
                      b
                      a
                  )
                  )
               startcell
               (list 0 0)
       )
)
(setq        endcell
       (mapcar '(lambda (a b)
                  (if        (not a)
                      b
                      a
                  )
                  )
               endcell
               (list row column)
       )
)
(setq        startrow    (car startcell)
        startcolumn (cadr startcell)
        endrow          (car endcell)
        endcolumn   (cadr endcell)
)
(repeat (+ 1 (- endrow startrow))
    (setq rtn nil)
    (setq n startcolumn)
    (repeat (+ 1 (- endcolumn startcolumn))

      (setq
        rtn (append
              rtn
              (list
                (dcl-grid-getcelltext gridname startrow n)
              )
          )
      )
      (setq n (1+ n))
    )
    (setq rtn1 (append rtn1 (list rtn)))
    (setq startrow (1+ startrow))
)
rtn1
)

Smile_小窑 发表于 2017-7-31 19:01:16

谢谢分享,下载看看,

Linhay 发表于 2017-8-1 12:12:39

您好,缺个zgx:acdoc函数{:1_12:}

brainstorm 发表于 2017-8-1 12:35:26

附件里有这个函数

Linhay 发表于 2017-8-1 13:09:44

brainstorm 发表于 2017-8-1 12:35


真的没有                  

liunian0524 发表于 2017-8-1 13:29:26

感谢楼主分享

Smile_小窑 发表于 2017-8-1 14:11:43

感谢分享,下载用用

yfywk 发表于 2017-8-1 15:03:40

命令: RENBLK
; 错误: no function definition: ZGX:ACDOC

brainstorm 发表于 2017-8-26 17:35:43

(defun zgx:acDoc        nil
(eval        (list 'defun
              'zgx:acdoc
              'nil
              (vla-get-activedocument (vlax-get-acad-object))
        )
)
(zgx:acdoc)
)
补上zgx:acdoc

abenmao168 发表于 2017-8-31 00:13:04

感谢分享,下下来试一下{:1_12:}

heqi110 发表于 2018-5-24 01:45:15

还是用不了,对话框也没有出现

feeling_chin 发表于 2021-2-2 17:21:11

回头来试下下

CAD56390 发表于 2021-11-4 13:33:54

感谢分享,十分牛批{:1_9:}

Longhien2021 发表于 2025-2-17 18:37:20

谢谢楼主分享!
页: [1] 2
查看完整版本: 重命名块对话框版,支持放大到指定块