前生 发表于 2003-8-15 13:19:00

[转帖]LISP匿名块程序：

LISP匿名块程序：
(defun c:cb ()
(setq pt (getpoint "\n插入点： "))
(entmake
    (list '(0 . "BLOCK") '(2 . "*U") '(70 . 1) (cons 10 pt))
)
(prompt "\n选择实体")
(setq ss1 (ssget)
i   (sslength ss1)
n   (- 1)
)
(repeat i
    (entmake (cdr (entget (ssname ss1 (setq n (1+ n))))))
)   
(setq num (entmake '((0 . "ENDBLK"))))
(entmake (list '(0 . "INSERT") (cons 2 num) (cons 10 pt)))
(command "erase" ss1 "")
(princ)
)

zgssd 发表于 2019-5-12 11:18:40

时间虽久,程序在CAD2010中使用良好,谢谢楼主

龙龙仔 发表于 2003-8-18 12:38:00

程序与目前明经提供的匿名块程序有相同的缺点,对pline及带属性图块会出错,
更简单的方法可以用正常的方式建图块,再改为匿名块

mccad 发表于 2003-8-18 12:42:00

龙大哥，你写一个用ActiveX方法的建匿名块的函数吧，用AX方法应该可以解决PLINE和属性块问题吧。

龙龙仔 发表于 2003-8-18 16:35:00

;;建立匿名块
;;by 龙龙仔
(defun C:NONAME_BLK (/ HOLDECHO HOLDBLIP A AA BLKREF)
(command "_.undo" "_group")
(setq HOLDECHO (getvar "cmdecho"))
(setq HOLDBLIP (getvar "blipmode"))
(setvar "cmdecho" 0)
(setvar "blipmode" 0)
(prompt "\n选取对象建立匿名块: ")
(setq AA (ssget))
(setq A (rtos (* (getvar "CDATE") 1E8)))
(if (/= AA NIL)
    (progn
      (command "_.BLOCK" A "0,0" AA "")
      (command "_.INSERT" A "@" "" "" "")
      (setq BLKREF (vlax-ename->vla-object (entlast)))
      (vla-put-name
(vla-item (vla-get-blocks
      (vla-get-activedocument (vlax-get-acad-object))
    )
    (vla-get-name BLKREF)
)
"*U"
      )
      (vlax-release-object BLKREF)
    )
    (alert "\n没有选取任何对象!")
)
(setvar "blipmode" HOLDBLIP)
(setvar "cmdecho" HOLDECHO)
(command "_.undo" "_end")
(princ)
)

无痕 发表于 2003-8-30 03:13:00

强！ 佩服龙兄

wangjiziji 发表于 2003-8-31 22:40:00

强，我顶

runkeji 发表于 2003-9-3 10:39:00

好：
我盯

asdf159 发表于 2006-1-23 16:34:00

龙龙仔发表于2003-8-18 12:38:00static/image/common/back.gif程序与目前明经提供的匿名块程序有相同的缺点,对pline及带属性图块会出错,更简单的方法可以用正常的方式建图块,再改为匿名块

<BR>说的没错，那怎么把正常的图块改名为匿名块？？？请指教。。

龙龙仔 发表于 2006-1-23 17:03:00

用VLISP直接改正常的图块为"*U"

asdf159 发表于 2006-1-24 11:40:00

龙龙仔发表于2006-1-23 17:03:00static/image/common/back.gif用VLISP直接改正常的图块为\"*U\"

<BR>呵呵，还请明示！
页: [1] 2 3 4 5
查看完整版本: [转帖]LISP匿名块程序：