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

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)
)

(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 startcell endcell /
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
)

;;;---获得grid指定单元格值----------------------------------------------------------------------------- 
;;;---startcell '(0 0)-, 取出全部---------------------------------------------------------------------- 
;;;---(get_grid_value '(2 nil) '(nil nil),  取出第二项开始所有单元格值--------------------------------- 
(defun get_grid_value (gridname          startcell  endcell        / 
                       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函数

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

感谢分享，下下来试一下

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

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

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

回头来试下下

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

感谢分享，十分牛批

账号		自动登录	找回密码
密码			立即注册

[图块] 重命名块对话框版，支持放大到指定块

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

评分