[编程交流] 表中的可选列

(defun c:tabord(/ aCen cAng cCen cPl cRad cReg
       fDr it lCnt lLst mSp pCen pT1
       pT2 ptLst R tHt tLst vlaPl vlaTab
       vLst cTxt oldCol nPl clFlg *error*)
 (vl-load-com)
 (defun Extract_DXF_Values(Ent Code)
   (mapcar 'cdr
    (vl-remove-if-not
     '(lambda(a)(=(car a)Code))
    (entget Ent)))
   ); end of
 (defun *error*(msg)
   (setvar "CMDECHO" 1)
   (princ)
   ); end of *error*
 (if
   (and
     (setq cPl(entsel "\nSelect LwPoliline > "))
     (= "LWPOLYLINE"(car(Extract_DXF_Values(car cPl)0)))
     ); end and
   (progn
     (setq vlaPl(vlax-ename->vla-object(car cPl))
       ptLst(mapcar 'append
                  (setq vLst(Extract_DXF_Values(car cPl)10))
                  (mapcar 'list(Extract_DXF_Values(car cPl)42)))
       lLst '("A" "B" "C" "D" "E" "F" "G" "H" "I" "J" "K" "L" "M"
           "N" "O" "P" "Q" "R" "S" "T" "U" "V" "W" "X" "Y" "Z")
       r 2 lCnt 0
       tLst '((1 0 "Point")(1 1 "X")(1 2 "Y")(1 3 "Radius"))
       mSp(vla-get-ModelSpace
            (vla-get-ActiveDocument
              (vlax-get-acad-object)))
       tHt(getvar "TEXTSIZE")
           ); end setq
       (setvar "CMDECHO" 0)
       (foreach vert ptLst
         (setq vert(trans vert 0 1)
           tLst(append tLst
             (list(list r 0 (nth lCnt lLst))
             (list r 1(rtos(car vert)2 4))
             (list r 2(rtos(cadr vert)2 4))
             (list r 3 ""))))
         (if(and
          (/= 0.0(last vert))
           (setq pt1(vlax-curve-GetPointAtParam vlaPl lCnt))
           (setq pt2(vlax-curve-GetPointAtParam vlaPl(1+ lCnt)))
          ); end and
       (setq r(1+ r)
             cRad(abs(/(distance pt1 pt2)
             2(sin(/(* 4(atan(abs(last vert))))2))))
             aCen(vlax-curve-GetPointAtParam vlaPl(+ 0.5 lCnt))
             fDr(vlax-curve-getFirstDeriv vlaPl
              (vlax-curve-getParamAtPoint vlaPl aCen))
             pCen(trans
               (polar aCen(-(if(minusp(last vert)) pi(* 2 pi))
                 (atan(/(car fDr)(cadr fDr))))cRad)0 1)
             tLst(append tLst(list
               (list r 0 "center")
               (list r 1(rtos(car pCen)2 4))
               (list r 2(rtos(cadr pCen)2 4))
               (list r 3(rtos cRad 2 4))))
             ); end setq
       ); end if
         (setq r(1+ r) lCnt(1+ lCnt))
         ); end foreach
     (setq vlaTab(vla-AddTable mSp (vlax-3D-point '(0 0 0))
           (+ 1(/(length tLst)4)) 4 (* 3 tHt)(* 18 tHt)))
     (foreach i tLst
       (vl-catch-all-apply 'vla-SetText(cons vlaTab i))
       (vla-SetCellTextHeight vlaTab(car i)(cadr i)tHt)
       (vla-SetCellAlignment vlaTab(car i)(cadr i)acMiddleCenter)
       ); end foreach
     (vla-DeleteRows vlaTab 0 1)
     (princ "\n<<< Place Table >>> ")
     (command "_.copybase" (trans '(0 0 0)0 1)(entlast) "")
     (command "_.erase" (entlast) "")
     (command "_.pasteclip" pause)
     (if(= :vlax-true(vla-get-Closed vlaPl))
       (progn
        (setq nPl(vla-Copy vlaPl))
        (command "_.region" (entlast) "")
        (setq cCen(vlax-get(setq cReg
        (vlax-ename->vla-object(entlast)))'Centroid))
         (vla-Delete cReg)
         (setq clFlg T)
        ); end progn
       ); end if
     (setq lCnt 0)
     (foreach v vLst
       (if clFlg
        (setq cAng(angle cCen(trans v 0 1))
              iPt(polar v cAng (* 2 tHt)))
        (setq fDr(vlax-curve-getFirstDeriv vlaPl
              (vlax-curve-getParamAtPoint vlaPl v))
          iPt(trans
           (polar v(-(* 2 pi)(atan(/(car fDr)(cadr fDr))))
                  (* 2 tHt))0 1)
          ); end if
         ); end if
       (setq cTxt(vla-AddText mSp(nth lCnt lLst)
              (vlax-3d-point iPt) tHt)
         lCnt(1+ lCnt)
         ); end setq
       (setq oldCol(getvar "CECOLOR"))
       (setvar "CECOLOR" "1")
       (command "_.circle" v (/ tHt 3))
       (setvar "CECOLOR" oldCol)
       ); end foreach
     (setvar "CMDECHO" 1)
     ); end progn
    (princ "\n<!> It isn't LwPolyline! Quit. <!> ")
   ); end if
   (princ)
   ); end of c:tabord