[编程交流] 谁能帮我查一下

(vl-load-com)
      
(setq *ActiveDocument*
      (vla-get-ActiveDocument
        (vlax-get-acad-object)
      ) ;_ end of vla-get-ActiveDocument
) ;_ end of setq
(setq *ModelSpace*
      (vla-get-ModelSpace
        *ActiveDocument*
      ) ;_ end of vla-get-ModelSpace
) ;_ end of setq
(setq *AcadBlock*
      (vla-get-blocks
        *ActiveDocument*
      ) ;_ end of vla-get-blocks
) ;_ end of setq
;;;Creat Num block with attribute
(defun Creat_Num_block (TextHight    radius          /
                cirPnt             blockObj          circleObj
                attributeObj
               )
 (setq cirPnt (list radius radius 0.0))
 (setq        blockObj     (vla-add *AcadBlock*
                      (vlax-3d-point cirPnt)
                      "num"
             )
circleObj    (vla-AddCircle
               blockObj
               (vlax-3d-point cirPnt)
               radius
             )
attributeObj
             (vla-AddAttribute
               blockObj
               TextHight
               acAttributeModeVerify
               ""
               (vlax-3d-point cirPnt)
               "nums"
               ""
             )
 )
 (vla-put-Alignment attributeObj acAlignmentMiddle)
 (if (> (setq v (distof (substr (getvar "acadver") 1 3))) 16.2)
   (vla-put-TextAlignmentPoint
     attributeObj
     (vlax-3d-point cirPnt)
   )
 )
 (vla-Update attributeObj)
)
(defun draw_leader (pt1 pt2 / leaderobj) ;draw leader
 (command "leader" pt1 pt2 "f" "st" "f" "a" "" "" "n")
 (setq leaderobj (vlax-ename->vla-object (entlast)))
 (vla-put-ArrowheadType leaderobj acArrowDotSmall)
 (vla-Update leaderobj)
 leaderobj
)
;;;set Attributes
(defun SetAtts (Obj Lst / AttVal)
 (mapcar
   '(lambda (Att)
      (if (setq AttVal (cdr (assoc (vla-get-TagString Att) Lst)))
 (vla-put-TextString Att AttVal)
      )
    )
   (vlax-invoke Obj "GetAttributes")
 )
 (vla-update Obj)
 (princ)
)
;;;Get numbers of block reference Object  in ModelSpace
(defun Get_blkRef_Num (blkRef_name / count objEnt)
 (setq count 0)
 (vlax-for objEnt *ModelSpace*
   (if        (equal (vla-get-ObjectName objEnt) "AcDbBlockReference")
     (progn (if (equal (vla-get-Name objEnt) blkRef_name)
       (setq count (1+ count))
     )
     )
   )
 )
 count
)
;;;check if have "num" block exist
(defun check_num_block (/)
 (if (ssget "X"
     '((0 . "INSERT")
       (2 . "num")
      )
     )
   T
   nil
 )
)
;;;--------------------------------------------------------------------;
;;;       Function:  set-params-obj                                    ;
;;;                                                                    ;
;;;    Description:  This function sets the parameters required        ;
;;;                  to associate a dimension object               .   ;
;;;                                                                    ;
;;;      Arguments:                                                    ;
;;;      vla-blk_bef = a valid vla blk_bef object.                     ;
;;;      vla-leader = a valid vla leader object.                       ;
;;;                                                                    ;
;;; Returned Value:  coordinates to the leader object.                 ;
;;;                                                                    ;
;;;          Usage:                                                    ;
;;;              (set-params-obj                                       ;
;;;                 vla-blk_bef  vla-leader                            ;
;;;               )                                                    ;
;;;--------------------------------------------------------------------;
(defun set-params-obj
      (vla-blk_bef vla-leader / ins-pnt lead-pnt1 lead-pnt2 sca rad)
 (if (and (= (type vla-blk_bef) 'VLA-OBJECT)
   (vlax-read-enabled-p vla-blk_bef)
     )
   (progn
     (setq ins-pnt (vla-get-InsertionPoint vla-blk_bef))
     (if (eq (type ins-pnt) 'VARIANT)
(if (> (vlax-variant-type ins-pnt) 8192)
  (setq
    ins-pnt (vlax-safearray->list (vlax-variant-value ins-pnt))
  )
)
     )
     (setq sca                (vla-get-XScaleFactor vla-blk_bef)
    rad         (vlax-ldata-get vla-blk_bef "radius")
    lead-pnt1        (vlax-curve-getstartpoint vla-leader)
    lead-pnt2        (polar ins-pnt (angle ins-pnt lead-pnt1) (* sca rad))
    Coordinates        (append lead-pnt1 lead-pnt2)
     )
   )
 )
)
;;;--------------------------------------------------------------------;
;;;       Function:  UPDATE-PARAMETER-MDIM                             ;
;;;                                                                    ;
;;;    Description:  This function is responsible for updating a       ;
;;;                  vla-object's parameter.                           ;
;;;                                                                    ;
;;;      Arguments:                                                    ;
;;;         vla-obj = a valid vla object.                              ;
;;;        par-name = a parameter name.                                ;
;;;       par-value = a new parameter value                            ;
;;;                                                                    ;
;;; Returned Value:  A vla object.                                     ;
;;;                                                                    ;
;;;          Usage:                                                    ;
;;;              (update-parameter-mdim                                ;
;;;                 vla-obj  par-name par-value                        ;
;;;               )                                                    ;
;;;--------------------------------------------------------------------;
(defun update-parameter-mdim (vla-obj par-name par-value)
 (if (and (= (type vla-obj) 'VLA-OBJECT)
   (vlax-write-enabled-p vla-obj)
   (not (equal (vlax-get vla-obj par-name) par-value))
     )
   (vlax-put vla-obj par-name par-value)
 )
)
;;;--------------------------------------------------------------------;
;;;       Function:  UPDATE-LEADER                                     ;
;;;                                                                    ;
;;;    Description:  This function updates the "coordinate" property   ;
;;;                  for the leader object.                            ;
;;;                                                                    ;
;;;      Arguments:                                                    ;
;;;         notifier = a valid vla object.                             ;
;;;         obj-list = a list of vla object.                           ;
;;;                                                                    ;
;;; Returned Value:  An updated leader object.                         ;
;;;                                                                    ;
;;;          Usage:                                                    ;
;;;              (update-leader                                        ;
;;;                   notifier obj-list                                ;
;;;               )                                                    ;
;;;--------------------------------------------------------------------;
(defun update-leader
             (notifier obj-list        / vla-blk_bef vla-leader)
 (setq        vla-blk_bef (nth 0 obj-list)
vla-leader  (nth 1 obj-list)
 )
 (if (set-params-obj vla-blk_bef vla-leader)
   (update-parameter-mdim vla-leader "Coordinates" Coordinates)
 )
)
;;;--------------------------------------------------------------------;
;;;       Function:  reactor-leader_blk_bef                           ;
;;;                                                                    ;
;;;    Description:  This function will be called inside               ;
;;;                  :vlr-modified event.                              ;
;;;                                                                    ;
;;;                  Required Functions:                               ;
;;;                         update-leader-for-blk_bef                  ;
;;;                                                                    ;
;;;      Arguments:                                                    ;
;;;        notifier = a valid vla object. Filled in by the calling     ;
;;;                   reactor.                                         ;
;;;         reactor = a valid vlr object reactor. Filled in by the     ;
;;;                   calling reactor.                                 ;
;;;        arg-list = argument list filled in by the calling reactor.  ;
;;;                   Filled in by the calling reactor.                ;
;;;                                                                    ;
;;; Returned Value:  A valid vla object.                        ;
;;;                                                                    ;
;;;          Usage:  Intended to be called from a reactor call back.   ;
;;;       (reactor-leader_blk_bef notifier reactor arg-list)          ;
;;;--------------------------------------------------------------------;
(defun reactor-leader_blk_bef (notifier reactor arg-list)
 (update-leader notifier (vlr-data reactor))
)
;;;--------------------------------------------------------------------;
;;;                       main Function                                 ;
;;;--------------------------------------------------------------------;
(defun c:draw_numbers (/          vla-leader TextHight        radius
               sca          loop1             loop2        pt0
               vla-blkref count             count_str        att_lst
               vla-leader sp             source        Points
               reactor
              )
 (setvar "CMDECHO" 0)
 (setq        TextHight 5
radius 5
sca 1
loop1 T
 )
 (if (not (check_num_block))
   (Creat_Num_block TextHight radius)
 )
 (while loop1
   (if        (setq pt0
       (getpoint
         "\nPick up a point (Enter & MouseRight exit):"
       )
)
     (progn
(setq vla-blkref
                 (vla-InsertBlock
                   *ModelSpace*
                   (vlax-3d-point pt0)
                   "num"
                   sca
                   sca
                   sca
                   0
                 )
      count         (Get_blkRef_Num "num")
      count_str         (itoa count)
      att_lst         (list (cons '"nums" count_str))
      loop2         T
)
(SetAtts vla-blkref att_lst)
(setq vla-leader (draw_leader pt0 (polar pt0 0 0.001)))
(prompt "\nConfirm number place:")
(while loop2
  (setq        sp     (grread T)
        source (car sp)
        sp     (cadr sp)
  ) ;_ end setq
  (cond        ((= source 5)
         (vla-put-InsertionPoint vla-blkref (vlax-3d-point sp))
         (setq
           Points
            (vlax-safearray-fill
              (vlax-make-safearray
                vlax-vbdouble
                '(0 . 5)
              )
              (append pt0
                      (polar sp (angle sp pt0) (* radius sca))
              )
            )
         )
         (if (> (distance sp pt0) (* radius sca))
           (vla-put-coordinates vla-leader Points)
         )
        )
        (t
         (progn        (setq loop2   nil
                      obj-lst (list vla-blkref vla-leader)
                )
                (vlax-ldata-put vla-blkref "radius" radius)
                (function reactor-leader_blk_bef)
                (setq reactor
                       (VLR-Object-reactor
                         obj-lst
                         obj-lst
                         '((:vlr-modified . reactor-leader_blk_bef))
                       )
                )
         )
        )
  )
)
     )
     (setq loop1 nil)
   )
 )
 (princ)
)

(defun draw_leader (pt1 pt2 / leaderobj) ;draw leader
 (command "leader" pt1 pt2 "f" "st" "f" "a" "" "" "n")
 (setq leaderobj (vlax-ename->vla-object (entlast)))
 (vla-put-ArrowheadType leaderobj acArrowDotSmall)
 [color=blue](vla-put-Arrowheadsize leaderobj (/ TextHight [color=red]1.0[/color]))[/color]
 (vla-Update leaderobj)
 leaderobj
)