求框选对象为块的程序？

cj52000

各位好：

            现需求一种程序，输入命令，然后框选所选对象直接转换为块，谢谢大家！

Andyhon

不需给块名?

qjchen

前几天在老虎空间帮人改了段代码（不好意思，不知道源代码是哪位的，采用了时间作为块名的方法），主要加了一段，让块的插入点在左下角的，就顺便贴一下 ：），有空再来改成不用command的

3. ;;std-lib
4. (defun std-sslist (ss / n lst)
5.   (if (eq 'pickset (type ss))
6.     (repeat (setq n (fix (sslength ss))) ; fixed
7.       (setq lst (cons (ssname ss (setq n (1- n))) lst))
8.     )
9.   )
10. )
11. ;;get the boundingbox of object by qjchen
12. (defun leftcornerofss(ss / maxpt maxptlst minpt minptlst obj x)
13.   (setq ss (std-sslist ss))
14.   (foreach x ss
15.     (setq obj (vlax-ename->vla-object x))
16.     (setq minPt (vlax-make-safearray vlax-vbdouble '(0 . 2)))
17.     (setq maxPt (vlax-make-safearray vlax-vbdouble '(0 . 2)))
18.     (vla-GetBoundingBox Obj 'minpt 'maxpt) ; 得到包围框
19.     (setq minPt (vlax-safearray->list minPt))
20.     (setq maxPt (vlax-safearray->list maxPt))
21.     (setq minPtlst (append minPtlst (list minPt)))
22.     (setq maxPtlst (append maxPtlst (list maxPt)))  
23.   )
24.   (list (apply 'min (mapcar 'car minPtlst))
25.         (apply 'min (mapcar 'cadr minPtlst))
26.         0
27.   )
28. )
35. (defun C:bkK (/ HOLDECHO HOLDBLIP A AA BLKREF pt left)
36.   (VL-LOAD-COM)
37.   (setq AA (ssget))
38.   (setq leftc (leftcornerofss AA))
39.   ;(grdraw (list 0 0 0) leftc 1)
40.   (command "_.undo" "_group")
41.   (setq HOLDECHO (getvar "cmdecho"))
42.   (setq HOLDBLIP (getvar "blipmode"))
43.   (setvar "cmdecho" 0)
44.   (setvar "blipmode" 0)  
45.   (setq A (rtos (* (getvar "CDATE") 1E8)))
46.   
47.   (if (/= AA NIL)
48.     (progn
49.       (command "_.BLOCK" A  "non" leftc AA "")
50.       (command "_.INSERT" A "non" leftc "" "" "")
51.     )
52.   )
53.   (setvar "blipmode" HOLDBLIP)
54.   (setvar "cmdecho" HOLDECHO)
55.   (command "_.undo" "_end")
56.   (princ)
57. )

;;std-lib (defun std-sslist (ss / n lst)   (if (eq 'pickset (type ss))     (repeat (setq n (fix (sslength ss))) ; fixed       (setq lst (cons (ssname ss (setq n (1- n))) lst))     )   ) ) ;;get the boundingbox of object by qjchen (defun leftcornerofss(ss / maxpt maxptlst minpt minptlst obj x)   (setq ss (std-sslist ss))   (foreach x ss     (setq obj (vlax-ename->vla-object x))     (setq minPt (vlax-make-safearray vlax-vbdouble '(0 . 2)))     (setq maxPt (vlax-make-safearray vlax-vbdouble '(0 . 2)))     (vla-GetBoundingBox Obj 'minpt 'maxpt) ; 得到包围框     (setq minPt (vlax-safearray->list minPt))     (setq maxPt (vlax-safearray->list maxPt))     (setq minPtlst (append minPtlst (list minPt)))     (setq maxPtlst (append maxPtlst (list maxPt)))     )   (list (apply 'min (mapcar 'car minPtlst))         (apply 'min (mapcar 'cadr minPtlst))         0   ) ) (defun C:bkK (/ HOLDECHO HOLDBLIP A AA BLKREF pt left)   (VL-LOAD-COM)   (setq AA (ssget))   (setq leftc (leftcornerofss AA))   ;(grdraw (list 0 0 0) leftc 1)   (command "_.undo" "_group")   (setq HOLDECHO (getvar "cmdecho"))   (setq HOLDBLIP (getvar "blipmode"))   (setvar "cmdecho" 0)   (setvar "blipmode" 0)     (setq A (rtos (* (getvar "CDATE") 1E8)))      (if (/= AA NIL)     (progn       (command "_.BLOCK" A  "non" leftc AA "")       (command "_.INSERT" A "non" leftc "" "" "")     )   )   (setvar "blipmode" HOLDBLIP)   (setvar "cmdecho" HOLDECHO)   (command "_.undo" "_end")   (princ) )

cj52000

谢谢楼上的热心，很好用！

yoyoho

哇!不错的思路,时间作为块名,学习了!

eachy

2. (defun c:tt (/ ss)
3.   (if (setq ss (ssget))
4.     (progn
5.       (vl-cmdf ".cutclip" ss "")
6.       (vl-cmdf ".pasteblock")
7.     )
8.   )
9.   (princ)
10. )

(defun c:tt (/ ss)   (if (setq ss (ssget))     (progn       (vl-cmdf ".cutclip" ss "")       (vl-cmdf ".pasteblock")     )   )   (princ) )

头大无恼

超好用，谢谢。

 

六楼也行，

 

不过如果三楼能加入一个输入块名的选项就更好，现在貌似按系统时间生成

狂刀lxx

不过如果三楼能加入一个输入块名的选项就更好，现在貌似按系统时间生成

-----那不跟用cad命令建块一样？还用编程？

AMTONNY

(defun c:BB ()
  (setvar "osmode" 183)
(COMMAND "UCS" "w")
  (setvar "ORTHOMODE" 0)
    (prompt "\n快速创建图块.....")
  (setq a (ssget))
  (command "_copybase" "0,0" a "")
   (COMMAND "ERASE" a "")
  (command "_pasteblock" "0,0" "")
  (setvar "ORTHOMODE" 1)
  (setq date0 (menucmd "M=$(edtime,$(getvar,date), YY.MO.DD hh.mm)"))
    (prompt "\n创建图块已OK.....当前日期:")  (princ date0)(princ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;