[编程交流] 动态块。请帮忙。

(defun c:dycnt(/ dySet prLst rpLst lLen)
(vl-load-com)
(defun #Asmi_Extract_Dynamic_Blocks(SelSet NameList / bCnt eCnt cBl eBl oSet)
 (if(and SelSet NameList)
   (progn
     (setq bCnt 0
    NameList(mapcar 'strcase NameList)
    eCnt(sslength SelSet)
    oSet(ssadd)
    ); end setq
     (repeat eCnt
(setq cBl(vlax-ename->vla-object
           (setq eBl(ssname SelSet bCnt))))
(if
  (and
   (= "AcDbBlockReference"(vla-get-ObjectName cBl))
   (vlax-property-available-p cBl 'EffectiveName)
   (member(strcase(vla-get-EffectiveName cBl))NameList)
   ); end and
  (ssadd eBl oSet)
 ); end if
(setq bCnt(1+ bCnt))
      ); end repeat
     );end progn
   ); end if
 oSet
 ); end of #Asmi_Extract_Dynamic_Blocks
(defun #Asmi_Get_Dynamic_Property(Block Property / oVal)
 (if(= 'ENAME(type Block))
   (setq Block(vlax-ename->vla-object Block))
   ); end if
 (if(= :vlax-true(vla-get-IsDynamicBlock Block))
   (foreach p(vlax-safearray->list
        (vlax-variant-value
          (vla-GetDynamicBlockProperties Block)))
     (if(=(strcase Property)(strcase(vla-get-PropertyName p)))
(if(vl-catch-all-error-p
     (setq oVal(vl-catch-all-apply
                 'vla-get-Value(list p))))
  nil
  (setq oVal(vlax-variant-value oVal))
  ); end if
); end if
     ); end foreach
   ); end if
 oVal
 ); end of #Asmi_Get_Dynamic_Property
 (defun #Asmi_Set_to_List(Sel_Set VLA / Out)
 (setq Out
 (vl-remove-if 'listp
   (mapcar 'cadr(ssnamex Sel_Set))))
    (if VLA
       (mapcar 'vlax-ename->vla-object Out)
      Out
      ); end if
   ); end of #Asmi_Set_to_List
 (if
   (and
     (setq dySet(ssget "_X" '((0 . "INSERT"))))
     (setq dySet
     (#Asmi_Extract_Dynamic_Blocks dySet
         '("Despiece (Prueba 03)")))
     ); end if
   (progn
     (foreach bl(#Asmi_Set_to_List dySet T)
(setq prLst(cons
              (list
                (#Asmi_Get_Dynamic_Property bl "Dist (A-B)")
                (#Asmi_Get_Dynamic_Property bl "Dist (C-B)")
                (#Asmi_Get_Dynamic_Property bl "Dist (A-C)")
                ); end list
                prLst
            ); end cons
        ); end setq
); end foreach
     (setq lLen(length prLst))
     (while prLst
         (setq rpLst(cons(append(car prLst)
                      (list(- lLen(setq lLen(length (setq prLst
                (vl-remove(car prLst)prLst)))))))rpLst)
          ); end setq
       ); end while
    (setq rpLst(vl-sort rpLst
                '(lambda(a b)(<(car a)(car b)))))
    (princ "\n\n A-B         C-B         A-C         Count")
    (princ "\n ------------------------------------------")
(foreach str rpLst
 (princ(strcat "\n "(rtos(car str)) " "))
 (repeat(- 10(strlen(rtos(car str))))(princ " "))
 (princ(strcat " "(rtos(cadr str)) " "))
 (repeat(- 10(strlen(rtos(cadr str))))(princ " "))
 (princ(strcat " "(rtos(nth 2 str))" "))
 (repeat(- 10(strlen(rtos(nth 2 str))))(princ " "))
 (princ(strcat " "(itoa(last str))))
); end foreach
     (princ "\n ------------------------------------------")
     (textscr)
     ); end progn
   ); end if
 (princ)
); end of c:dycnt

Command: dycnt
A-B         C-B         A-C         Count
------------------------------------------
4           1           3           1
10          4           6           2
10          5.5         4.5         1
14          8           6           2
14          9.5         4.5         10
20          14          6           1
20          15.5        4.5         14
26          20          6           1
26          21.5        4.5         2
------------------------------------------