[转贴]：Automating Bubble Blocks Using ActiveX

eachy · 发表于 2004-8-13 13:27:53

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

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

×

http://www.digitalcad.com/articles/viewarticle.jsp?id=11290

(defun c:db (/ bk attr fa sa p2 p3 ad)
(setq *old-error* *error*
*error* *db-error*
)
(if (not (tblsearch "block" "db"))
(create-detail-bubble)
)
(while (setq p1 (getpoint " Pick Insertion: "))
(if p1
(progn
(setq ad (vla-get-modelspace
(vla-get-ActiveDocument
(vlax-get-Acad-Object)
)
)
)
(vla-insertblock
ad
p1
"db"
(getvar "dimscale")
(getvar "dimscale")
"0"
)
(setq bk (vlax-ename->vla-object (entlast))
attr (vla-getattributes bk)
fa (car attr)
sa (car (reverse attr))
p2 (polar p1 (dtr 90.00) (* 0.120 (GETVAR "DIMSCALE")))
p3 (polar p1 (dtr -90.00) (* 0.120 (GETVAR "DIMSCALE")))
)
(vla-put-insertionPoint fa p2)
(vla-put-insertionPoint sa p3)
(vla-put-horizontalalignment fa 1)
(vla-put-horizontalalignment sa 1)
(vla-put-verticalalignment fa 2)
(vla-put-verticalalignment sa 2)
(vla-put-layer fa "0")
(vla-put-layer sa "0")
(vla-put-color fa acByLayer)
(vla-put-color sa acByLayer)
(vla-put-height fa (* 0.1042 (GETVAR "DIMSCALE")))
(vla-put-height sa (* 0.1042 (GETVAR "DIMSCALE")))
(vla-put-stylename fa "ROMANS")
(vla-put-stylename sa "ROMANS")
(vla-put-textalignmentpoint fa p2)
(vla-put-textalignmentpoint sa p3)
(db-create-flag)
)
)
)
(setq *error* *old-error*
p1 nil
)
(princ)
)
(defun db-create-flag (/ p2 p3 di an f1 f2 f3 f4)
(while
(setq p2 (getpoint p1 " Pick Point: "))
(progn
(if
(not ss)
(setq
p1 (polar p1 (angle p1 p2) (* (getvar "dimscale") 0.2188))
)
)
(entmake (list (cons 0 "LINE")
(cons 10 p1)
(cons 11 p2)
(cons 8
(getvar "clayer")
)
(cons 62 256)
)
)
(if (not ss)
(setq ss (ssadd))
)
(setq ss (ssadd (entlast) ss))
(setq b1 p1
p1 p2
)
)
)
(if ss
(progn
(setq p2 (getpoint p1 " Place Flag: "))
(if p2
(progn
(setq di (distance p1 p2)
an (angle b1 p1)
f2 (polar p1 an di)
f1 (polar p1 (+ an (dtr 90.00)) 0.75)
f2 (polar f2 (+ an (dtr 90.00)) 0.75)
f3 (polar f2 (+ an (dtr -90.00)) 1.5)
f4 (polar f1 (+ an (dtr -90.00)) 1.5)
)
(entmake (list (cons 0 "LINE")
(cons 10 f1)
(cons 11 f2)
(cons 8
(getvar "clayer")
)
(cons 62 256)
)
)
(entmake (list (cons 0 "LINE")
(cons 10 f3)
(cons 11 f4)
(cons 8
(getvar "clayer")
)
(cons 62 256)
)
)
(entmake (list (cons 0 "LINE")
(cons 10 f1)
(cons 11 f4)
(cons 8
(getvar "clayer")
)
(cons 62 256)
)
)
)
)
)
)
(setq ss nil)
(princ)
)
(defun *db-error* (msg)
(command "erase" ss "")
(setq *error* *old-error*
ss nil
)
(princ)
)
(defun create-detail-bubble (/)
(if (= (tblsearch "style" "romans") nil)
(command "style" "romans" "romans.shx" "" ".85" "" "" "" "")
)
(entmake '((0 . "block")
(2 . "db")
(70 . 2)
(10 0.0 0.0 0.0)
(8 . "0")
)
)
(entmake '((0 . "ATTDEF")
(10 -0.21503 0.0563637 0.0)
(40 . 0.104167)
(1 . "-")
(50 . 0.0)
(41 . 0.85)
(51 . 0.0)
(7 . "ROMANS")
(71 . 0)
(72 . 1)
(11 0.0 0.108447 0.0)
(210 0.0 0.0 1.0)
(3 . "DETAIL NUMBER")
(2 . "DETAIL")
(73 . 0)
(74 . 2)
(70 . 0)
(8 . "0")
)
)
(entmake '((0 . "ATTDEF")
(10 -0.206597 -0.162386 0.0)
(40 . 0.104167)
(1 . "-")
(50 . 0.0)
(41 . 0.85)
(51 . 0.0)
(7 . "ROMANS")
(71 . 0)
(72 . 4)
(11 0.0 -0.110303 0.0)
(210 0.0 0.0 1.0)
(3 . "SHEET NUMBER")
(2 . "SHEET")
(73 . 0)
(74 . 0)
(70 . 0)
(8 . "0")
)
)
(entmake '((0 . "LINE")
(10 0.21875 0.0 0.0)
(11 -0.21875 0.0 0.0)
(8
.
"0"
)
)
)
(entmake
'((0 . "CIRCLE") (10 0.0 0.0 0.0) (40 . 0.21875) (8 . "0"))
)
(entmake '((0 . "ENDBLK")))
(princ)
)
(defun dtr (a)
(* pi (/ a 180.0))
)
(defun rtd (a)
(/ (* a 180.0) pi)
)

(defun c:db (/ bk attr fa sa p2 p3 ad) 
  (setq        *old-error* *error* 
        *error*            *db-error* 
  ) 
  (if (not (tblsearch "block" "db")) 
    (create-detail-bubble) 
  ) 
  (while (setq p1 (getpoint " Pick Insertion: ")) 
    (if        p1 
      (progn 
        (setq ad (vla-get-modelspace 
                   (vla-get-ActiveDocument 
                     (vlax-get-Acad-Object) 
                   ) 
                 ) 
        ) 
        (vla-insertblock 
          ad 
          p1 
          "db" 
          (getvar "dimscale") 
          (getvar "dimscale") 
          "0" 
        ) 
        (setq bk   (vlax-ename->vla-object (entlast)) 
              attr (vla-getattributes bk) 
              fa   (car attr) 
              sa   (car (reverse attr)) 
              p2   (polar p1 (dtr 90.00) (* 0.120 (GETVAR "DIMSCALE"))) 
              p3   (polar p1 (dtr -90.00) (* 0.120 (GETVAR "DIMSCALE"))) 
        ) 
        (vla-put-insertionPoint fa p2) 
        (vla-put-insertionPoint sa p3) 
 
        (vla-put-horizontalalignment fa 1) 
        (vla-put-horizontalalignment sa 1) 
        (vla-put-verticalalignment fa 2) 
        (vla-put-verticalalignment sa 2) 
        (vla-put-layer fa "0") 
        (vla-put-layer sa "0") 
        (vla-put-color fa acByLayer) 
        (vla-put-color sa acByLayer) 
        (vla-put-height fa (* 0.1042 (GETVAR "DIMSCALE"))) 
        (vla-put-height sa (* 0.1042 (GETVAR "DIMSCALE"))) 
        (vla-put-stylename fa "ROMANS") 
        (vla-put-stylename sa "ROMANS") 
        (vla-put-textalignmentpoint fa p2) 
        (vla-put-textalignmentpoint sa p3) 
        (db-create-flag) 
      ) 
    ) 
  ) 
  (setq        *error*        *old-error* 
        p1        nil 
  ) 
  (princ) 
) 
(defun db-create-flag (/ p2 p3 di an f1 f2 f3 f4) 
  (while 
    (setq p2 (getpoint p1 " Pick Point: ")) 
     (progn 
       (if 
         (not ss) 
          (setq 
            p1 (polar p1 (angle p1 p2) (* (getvar "dimscale") 0.2188)) 
          ) 
       ) 
       (entmake        (list (cons 0 "LINE") 
                      (cons 10 p1) 
                      (cons 11 p2) 
                      (cons 8 
                            (getvar "clayer") 
                      ) 
                      (cons 62 256) 
                ) 
       ) 
       (if (not ss) 
         (setq ss (ssadd)) 
       ) 
       (setq ss (ssadd (entlast) ss)) 
       (setq b1        p1 
             p1        p2 
       ) 
     ) 
  ) 
  (if ss 
    (progn 
      (setq p2 (getpoint p1 " Place Flag: ")) 
      (if p2 
        (progn 
          (setq        di (distance p1 p2) 
                an (angle b1 p1) 
                f2 (polar p1 an di) 
                f1 (polar p1 (+ an (dtr 90.00)) 0.75) 
                f2 (polar f2 (+ an (dtr 90.00)) 0.75) 
                f3 (polar f2 (+ an (dtr -90.00)) 1.5) 
                f4 (polar f1 (+ an (dtr -90.00)) 1.5) 
          ) 
          (entmake (list (cons 0 "LINE") 
                         (cons 10 f1) 
                         (cons 11 f2) 
                         (cons 8 
                               (getvar "clayer") 
                         ) 
                         (cons 62 256) 
                   ) 
          ) 
          (entmake (list (cons 0 "LINE") 
                         (cons 10 f3) 
                         (cons 11 f4) 
                         (cons 8 
                               (getvar "clayer") 
                         ) 
                         (cons 62 256) 
                   ) 
          ) 
          (entmake (list (cons 0 "LINE") 
                         (cons 10 f1) 
                         (cons 11 f4) 
                         (cons 8 
                               (getvar "clayer") 
                         ) 
                         (cons 62 256) 
                   ) 
          ) 
        ) 
      ) 
    ) 
  ) 
  (setq ss nil) 
  (princ) 
) 
(defun *db-error* (msg) 
  (command "erase" ss "") 
  (setq        *error*        *old-error* 
        ss        nil 
  ) 
  (princ) 
) 
(defun create-detail-bubble (/) 
  (if (= (tblsearch "style" "romans") nil) 
    (command "style" "romans" "romans.shx" "" ".85" "" "" "" "") 
  ) 
  (entmake '((0 . "block") 
             (2 . "db") 
             (70 . 2) 
             (10 0.0 0.0 0.0) 
             (8 . "0") 
            ) 
  ) 
  (entmake '((0 . "ATTDEF") 
             (10 -0.21503 0.0563637 0.0) 
             (40 . 0.104167) 
             (1 . "-") 
             (50 . 0.0) 
             (41 . 0.85) 
             (51 . 0.0) 
             (7 . "ROMANS") 
             (71 . 0) 
             (72 . 1) 
             (11 0.0 0.108447 0.0) 
             (210 0.0 0.0 1.0) 
             (3 . "DETAIL NUMBER") 
             (2 . "DETAIL") 
             (73 . 0) 
             (74 . 2) 
             (70 . 0) 
             (8 . "0") 
            ) 
  ) 
  (entmake '((0 . "ATTDEF") 
             (10 -0.206597 -0.162386 0.0) 
             (40 . 0.104167) 
             (1 . "-") 
             (50 . 0.0) 
             (41 . 0.85) 
             (51 . 0.0) 
             (7 . "ROMANS") 
             (71 . 0) 
             (72 . 4) 
             (11 0.0 -0.110303 0.0) 
             (210 0.0 0.0 1.0) 
             (3 . "SHEET NUMBER") 
             (2 . "SHEET") 
             (73 . 0) 
             (74 . 0) 
             (70 . 0) 
             (8 . "0") 
            ) 
  ) 
  (entmake '((0 . "LINE") 
             (10 0.21875 0.0 0.0) 
             (11 -0.21875 0.0 0.0) 
             (8 
              . 
              "0" 
             ) 
            ) 
  ) 
  (entmake 
    '((0 . "CIRCLE") (10 0.0 0.0 0.0) (40 . 0.21875) (8 . "0")) 
  ) 
  (entmake '((0 . "ENDBLK"))) 
  (princ) 
) 
(defun dtr (a) 
  (* pi (/ a 180.0)) 
) 
(defun rtd (a) 
  (/ (* a 180.0) pi) 
)

yjtdkj · 发表于 2004-8-18 15:24:00

请问怎么用呀？输入命令后提示：
Pick Insertion: 未知命令“db”。按 F1 查看帮助。
命令: db Pick Insertion: 未知命令“db”。按 F1 查看帮助。

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

[转贴]：Automating Bubble Blocks Using ActiveX

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

相关帖子