【KAIXIN】----通用函数,跟贴伪源码

【KAIXIN】

2. ;(改块名)无名转有名  作者：【KAIXIN】，QQ：295963716
   
3. ;本程序需要KAIXIN通用函数的支持
   
4. (defun C:XX (/ obj bkn)
   
5. (KX-COMA)
   
6. (KX-princA "(改块名)无名转有名")
   
7.   (setq obj (KX-E2O (CAR (KX-Get-Entsel '((0 . "INSERT")(2 . "`**")) "无名块"))));转为VLA对象
   
8.   (setq bkn (KX-str 1 "块名" bkn nil nil))
   
9.   (KX-Wm2Insert obj bkn);改块名
   
10. (KX-COMB)
    
11. )
    

;(改块名)无名转有名  作者：【KAIXIN】，QQ：295963716<br /> ;本程序需要KAIXIN通用函数的支持<br /> (defun C:XX (/ obj bkn)<br /> (KX-COMA)<br /> (KX-princA "(改块名)无名转有名")<br />   (setq obj (KX-E2O (CAR (KX-Get-Entsel '((0 . "INSERT")(2 . "`**")) "无名块"))));转为VLA对象<br />   (setq bkn (KX-str 1 "块名" bkn nil nil))<br />   (KX-Wm2Insert obj bkn);改块名<br /> (KX-COMB)<br /> )<br />

【KAIXIN】

2. ;目录图纸下插入图档里面的块   作者：【KAIXIN】，QQ：295963716
   
3. ;本程序需要KAIXIN通用函数的支持
   
4. (DEFUN C:XX (/ BLK P1)
   
5. (KX-COMA)
   
6. (KX-princA "目录图纸下插入块")
   
7.    (apply 'vl-cmdf (list "_.insert" "d:\\1.dwg" "0,0" "1" "" ""));目录可改
   
8.      (KX-E (entlast))
   
9.     (while (/= (setq blk (KX-str 0 "块名" "" nil nil) ) "")
   
10.       (while (setq p1 (getpoint "\n->请指定基点: "))
    
11.         (KX-Mk-Insert blk p1 0)
    
12.       )
    
13.     )
    
14.    (apply 'vl-cmdf (list "_.purge" "all" ""  "n"))
    
15. (KX-COMB)
    
16. )

;目录图纸下插入图档里面的块   作者：【KAIXIN】，QQ：295963716<br /> ;本程序需要KAIXIN通用函数的支持<br /> (DEFUN C:XX (/ BLK P1)<br /> (KX-COMA)<br /> (KX-princA "目录图纸下插入块")<br />    (apply 'vl-cmdf (list "_.insert" "d:\\1.dwg" "0,0" "1" "" ""));目录可改<br />      (KX-E (entlast))<br />     (while (/= (setq blk (KX-str 0 "块名" "" nil nil) ) "")<br />       (while (setq p1 (getpoint "\n->请指定基点: "))<br />         (KX-Mk-Insert blk p1 0)<br />       ) <br />     )<br />    (apply 'vl-cmdf (list "_.purge" "all" ""  "n"))<br /> (KX-COMB) <br /> )

【KAIXIN】

2. ;更改块名（所有同名块）
   
3. (DEFUN C:XX (/ ENTNAM NEWNAM)
   
4. (KX-COMA)
   
5. (KX-princA "更改块名（所有同名块）")
   
6.   (setq EntNam (car (KX-GET-entsel '((0 . "INSERT")) "块")))
   
7.     (if (setq NewNam (KX-str 1 "新块名<字符规范,不要重名>" str nil ChuShi))
   
8.       (KX-Put-Bkname EntNam NewNam)
   
9.       (princ "\n你没有输入新块名!")
   
10.     )
    
11. (KX-COMB)
    
12. )
    

;更改块名（所有同名块）<br /> (DEFUN C:XX (/ ENTNAM NEWNAM)<br /> (KX-COMA)<br /> (KX-princA "更改块名（所有同名块）")<br />   (setq EntNam (car (KX-GET-entsel '((0 . "INSERT")) "块")))<br />     (if (setq NewNam (KX-str 1 "新块名<字符规范,不要重名>" str nil ChuShi))<br />       (KX-Put-Bkname EntNam NewNam)<br />       (princ "\n你没有输入新块名!")<br />     )<br /> (KX-COMB)<br /> )<br />

【KAIXIN】

2. ;块替换
   
3. (DEFUN C:XX (/ S1 BLKNAME SS X)
   
4. (KX-COMA)
   
5. (KX-princA "块替换")
   
6.   (setvar "osmode" 0)
   
7.   (SETQ s1 (KX-GET-entsel '((0 . "INSERT")) "源块"))
   
8.   (setq BlkName (KX-get-dxf 2 (CAR s1)))
   
9.   (princ "\n-->请选取将替换的图块:")
   
10. (while(setq ss (ssget":s" (list (cons 0 "INSERT"))))
    
11.              (setq X -1 )
    
12.     (while (setq s1 (ssname ss (setq X (1+ X))))
    
13.        (KX-PUT-DXF s1 2 BlkName)
    
14.     )
    
15. )
    
16. (KX-COMB)
    
17. )

;块替换<br /> (DEFUN C:XX (/ S1 BLKNAME SS X)<br /> (KX-COMA)<br /> (KX-princA "块替换")<br />   (setvar "osmode" 0)<br />   (SETQ s1 (KX-GET-entsel '((0 . "INSERT")) "源块")) <br />   (setq BlkName (KX-get-dxf 2 (CAR s1)))<br />   (princ "\n-->请选取将替换的图块:")<br /> (while(setq ss (ssget":s" (list (cons 0 "INSERT"))))<br />              (setq X -1 )<br />     (while (setq s1 (ssname ss (setq X (1+ X)))) <br />        (KX-PUT-DXF s1 2 BlkName)<br />     )<br /> )<br /> (KX-COMB)<br /> )

【KAIXIN】

2. ;点选删除所有同名图块
   
3. (DEFUN C:XX (/ S1 ET SS SL)
   
4. (KX-COMA)
   
5. (KX-princA "点选删除所有同名图块")
   
6.    (SETQ s1 (KX-GET-entsel '((0 . "INSERT")) "样板块")
   
7.          et (KX-get-DXF 0 (car s1))
   
8.    )
   
9. 
   
10.       (setq ss (ssget "X" (list (cons 0 "INSERT") (cons 2 (KX-get-DXF 2 (car s1)))))
    
11.             sl (sslength ss)
    
12.       )
    
13.       (KX-E ss)
    
14.       (princ "\n共删除同名图块 ")
    
15.       (princ sl)
    
16.       (princ " 个!")
    
17. (KX-COMB)
    
18. )
    

;点选删除所有同名图块<br /> (DEFUN C:XX (/ S1 ET SS SL)<br /> (KX-COMA)<br /> (KX-princA "点选删除所有同名图块")<br />    (SETQ s1 (KX-GET-entsel '((0 . "INSERT")) "样板块")<br />          et (KX-get-DXF 0 (car s1))<br />    )<br /> <br />       (setq ss (ssget "X" (list (cons 0 "INSERT") (cons 2 (KX-get-DXF 2 (car s1)))))<br />             sl (sslength ss)<br />       )<br />       (KX-E ss)<br />       (princ "\n共删除同名图块 ")<br />       (princ sl)<br />       (princ " 个!")<br /> (KX-COMB)<br /> )<br />

懵懂女孩

看看是什么东西

200853006

顶 楼主

【KAIXIN】

2. (DEFUN C:XX (/ SS I S1 VS FLG)
   
3. (KX-COMA)
   
4. (KX-princA "添加或删除尺寸的方框")
   
5.       (KX-PRINC "标注对象")
   
6.    (setvar "regenmode" 1)
   
7. (while
   
8.   (setq        ss (SSGET":s" '((0 . "DIMENSION"))))
   
9.   (setq i  -1)
   
10.   (while (setq s1 (ssname ss (setq i (1+ i))))
    
11.       (setq vs (KX-E2O s1));转为VLA对象
    
12.       (setq flg (vla-get-TextGap vs))
    
13.       (if (< flg 0)
    
14.       (vla-put-TextGap vs 1)
    
15.       (vla-put-TextGap vs -1)
    
16.       )
    
17.   )
    
18. )
    
19. (KX-COMB)
    
20. )添加或删除尺寸的方框

(DEFUN C:XX (/ SS I S1 VS FLG)<br /> (KX-COMA)<br /> (KX-princA "添加或删除尺寸的方框")<br />       (KX-PRINC "标注对象")<br />    (setvar "regenmode" 1) <br /> (while<br />   (setq        ss (SSGET":s" '((0 . "DIMENSION"))))<br />   (setq i  -1)<br />   (while (setq s1 (ssname ss (setq i (1+ i))))<br />       (setq vs (KX-E2O s1));转为VLA对象<br />       (setq flg (vla-get-TextGap vs))<br />       (if (< flg 0)<br />       (vla-put-TextGap vs 1)<br />       (vla-put-TextGap vs -1)<br />       ) <br />   ) <br /> )<br /> (KX-COMB)<br /> )添加或删除尺寸的方框

【KAIXIN】

2. ;创建并插入匿名块，作者：【KAIXIN】，QQ：295963716
   
3. ;本程序需要KAIXIN通用函数的支持
   
4. (DEFUN C:XX (/ PT)
   
5. (KX-COMA)
   
6. (KX-princA "创建并插入匿名块")
   
7.    (while (KX-PRINC "成块的对象")
   
8.       (setq ss  (SSGET)
   
9.             pt (getpoint "\n-->请指定块基点：")
   
10.       )
    
11.     (KX-Mk-Wm-Block SS pt)
    
12.    )
    
13. (KX-COMB)
    
14. )

;创建并插入匿名块，作者：【KAIXIN】，QQ：295963716<br /> ;本程序需要KAIXIN通用函数的支持 <br /> (DEFUN C:XX (/ PT) <br /> (KX-COMA)<br /> (KX-princA "创建并插入匿名块")<br />    (while (KX-PRINC "成块的对象")<br />       (setq ss  (SSGET)<br />             pt (getpoint "\n-->请指定块基点：")<br />       )<br />     (KX-Mk-Wm-Block SS pt)<br />    )<br /> (KX-COMB)<br /> )

露草

下载来学习 学习