LISP实现BLOCK命令

Lisphk · 发表于 2021-1-30 02:41:31

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

您需要登录才可以下载或查看，没有账号？立即注册

×

(defun c:mblock (/ bkn eee i ndx nm ssst st)
(if (and (setq ssst (ssget)) (setq st (getpoint "\nInsertion point: ")))
;; RJP modified to generate a "Block-#" name
(progn (setq i -1)
(setq ndx 0)
(while (tblobjname "block" (setq nm (strcat "Block-" (itoa (setq i (1+ i)))))))
(entmake (list '(0 . "BLOCK")
'(100 . "AcDbEntity")
'(67 . 0)
'(8 . "0")
'(100 . "AcDbBlockReference")
(cons 2 nm)
(cons 10 st)
'(70 . 0)
)
)
(repeat (sslength ssst)
(entmake (cdr (entget (ssname ssst ndx))))
(entdel (ssname ssst ndx))
(setq ndx (+ 1 ndx))
)
(entmake '((0 . "ENDBLK") (100 . "AcDbBlockEnd") (8 . "0")))
(entmake (list (cons 0 "INSERT")
(cons 2 nm)
(cons 6 (getvar "CELTYPE"))
(cons 8 (getvar "CLAYER"))
(cons 66 0)
(cons 10 st)
(cons 41 1)
(cons 42 1)
(cons 43 1)
(cons 50 0)
(cons 71 0)
(cons 44 0)
(cons 45 0)
)
)
)
)
(princ)
)

(defun c:mblock (/ bkn eee i ndx nm ssst st) 
  (if (and (setq ssst (ssget)) (setq st (getpoint "\nInsertion point: "))) 
    ;; RJP modified to generate a "Block-#" name 
    (progn (setq i -1) 
           (setq ndx 0) 
           (while (tblobjname "block" (setq nm (strcat "Block-" (itoa (setq i (1+ i))))))) 
           (entmake (list '(0 . "BLOCK") 
                          '(100 . "AcDbEntity") 
                          '(67 . 0) 
                          '(8 . "0") 
                          '(100 . "AcDbBlockReference") 
                          (cons 2 nm) 
                          (cons 10 st) 
                          '(70 . 0) 
                    ) 
           ) 
           (repeat (sslength ssst) 
             (entmake (cdr (entget (ssname ssst ndx)))) 
             (entdel (ssname ssst ndx)) 
             (setq ndx (+ 1 ndx)) 
           ) 
           (entmake '((0 . "ENDBLK") (100 . "AcDbBlockEnd") (8 . "0"))) 
           (entmake (list (cons 0 "INSERT") 
                          (cons 2 nm) 
                          (cons 6 (getvar "CELTYPE")) 
                          (cons 8 (getvar "CLAYER")) 
                          (cons 66 0) 
                          (cons 10 st) 
                          (cons 41 1) 
                          (cons 42 1) 
                          (cons 43 1) 
                          (cons 50 0) 
                          (cons 71 0) 
                          (cons 44 0) 
                          (cons 45 0) 
                    ) 
           ) 
    ) 
  ) 
  (princ) 
)

hh_lj007 · 发表于 2021-1-30 09:37:33

每日一学、每日一抄

zc1zc2 · 发表于 2021-1-30 12:37:06

谢谢分享。。。。。。。。。。。

xxchemkin · 发表于 2021-2-10 13:52:35

简洁，明了。厉害。

xxchemkin · 发表于 2021-2-10 13:55:31

xxchemkin 发表于 2021-2-10 13:52
简洁，明了。厉害。

图元太多，返回“无效的复杂对象”。

xxchemkin · 发表于 2021-2-10 14:58:31

使用(entmake (cdr (entget (ssname ssst ndx)))) 重建图元，如果图元附着Xdata，重建的图元没有扩展数据，比如xdata中标注的小数位数、标注线性比例，同时，选择附着大量xdata信息图元过多，会返回“无效的复杂对象”，做块就失败了。跪求楼主解决。

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

[每日一码] LISP实现BLOCK命令

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

点评