修改图块的插入点

王鹏_pBZlo

命令:BASC;源码回复可见(defun c:basc( / blk pt blk2 blk41 blk42 blk50 blk10 temposm lin sset bnum npt blkpro)
        (defun point(pbase sx sy) (list (+ (car pbase) sx)(+ (cadr pbase) sy)))        (defun ass (num entity / tempvalue)
        (setq tempvalue (cdr (assoc num (entget entity))))
        (if (and (= 62 num) (null tempvalue)) (setq tempvalue 256))
        (if (and (= 6 num) (null tempvalue)) (setq tempvalue "Bylayer"))
        (setq tempvalue tempvalue))        
        (command "undo" "be")
        (setq blk(car (entsel "\n选择需调整插入点的块:")))
        (command "ucs" "")
        (setq pt (getpoint "\n新的插入点:"))
        (setq blkpro (entget blk))
        (setq blk2 (cdr (assoc 2 blkpro)))
        (setq blk41 (cdr (assoc 41 blkpro)))
        (setq blk42 (cdr (assoc 42 blkpro)))
        (setq blk50 (cdr (assoc 50 blkpro)))
        (setq blk10 (cdr (assoc 10 blkpro)))
        (setq temposm (getvar "osmode"))
        (setvar "osmode" 0)
        (command "line" blk10 pt "")
        (setq lin (entlast))
        (if (/= blk50 0.0) (command "rotate" lin "" blk10 (* -180.0 (/ blk50 pi))))
        (setq pt (list (/ (- (nth 0 (ass 11 lin)) (nth 0 blk10)) blk41) (/ (- (nth 1 (ass 11 lin)) (nth 1 blk10)) blk42)))
        (command "erase" lin "")
        (command "bedit" blk2)
        (command "move" "all" "" pt (list 0 0))
        (command "bclose" "")
        (setq sset (ssget "x" (list (cons 0 "INSERT")(cons 2 blk2))))
        (setq bnum 0)
        (while (setq blk (ssname sset bnum))
                (setq blk10 (ass 10 blk))
                (setq npt (point blk10 (* (ass 41 blk) (nth 0 pt)) (* (ass 42 blk) (nth 1 pt))))        
                (command "line" blk10 npt "") (setq lin (entlast))
                (if (/= (setq blk50 (ass 50 blk)) 0.0) (command "rotate" lin "" blk10 (* 180.0 (/ blk50 pi))))
                (command "move" blk "" blk10 (ass 11 lin))
                (command "erase" lin "")
                (setq bnum (1+ bnum))
        )
        (setvar "osmode" temposm)
        (command "undo" "e")
        (princ)
)

newer

纯LISP的，不错

yoyoho

谢谢分享! 回覆学习!!!!!

Michael527

实用的工具，谢谢分享

zhystar

谢谢楼主分享

echizenace

谢谢分享6666

yuren008

不错的插件，谢谢楼主分享。

coverne

实用的工具，谢谢分享

xudi1234

感谢分享，，这个功能CAD是不是有自带的1？

fengyun7000

看看学学习以下

tzfcn

直接编辑块也可以的。

王鹏_pBZlo

tzfcn 发表于 2019-3-15 11:38
直接编辑块也可以的。

如果这个块有多个，直接修改后这些块就会改变他它们的位置，需要一个个的移动会原来的位置
来自: 微社区

王鹏_pBZlo

xudi1234 发表于 2019-3-15 11:22
感谢分享，，这个功能CAD是不是有自带的1？

如果有，请说明一下，谢谢
来自: 微社区

sicky111

这个功能比较实用。

dwg001

回复看看，学习一下