[编程交流] 超链接坐标到选项卡

(defun c:ppoint()
 (and
    (setq cLp(entsel "\nSelect LwPoliline > "))
    (= "LWPOLYLINE"(cdr(assoc 0(setq cLp(entget(car cLp))))))
    (mapcar '(lambda(x)(vl-cmdf "_.point" x))(mapcar 'cdr
     (vl-remove-if-not '(lambda(a)(= 10(car a)))cLp)))
   ); end and
 (princ)
 ); end of c:ppoint

(defun c:tabord(/ cPl cTb ptLst vlaTab hitPt hitRes
        ptLst Row Column rCnt adNum chT cStr)
 (vl-load-com)
 (defun Extract_DXF_Code(Entity Code / cPl)
   (cdr(assoc Code(setq cPl(entget(car Entity)))))
   ); end of Extract_DXF_Code
 (if
   (and
     (setq cPl(entsel "\nSelect LwPoliline > "))
     (= "LWPOLYLINE"(Extract_DXF_Code cPl 0))
     ); end and
     (if
(and
  (setq cTb(entsel "\nSelect Table > "))
  (= "ACAD_TABLE"(Extract_DXF_Code cTb 0))
  ); end and
(if
  (setq cPt(getpoint "\nClick inside first cell > "))
  (progn
    (setq vlaTab(vlax-ename->vla-object(car cTb))
          hitPt (vlax-3D-Point(trans cPt 1 0))
          hitRes(vla-HitTest vlaTab hitPt
                        (vlax-3D-Point '(0.0 0.0 1.0)) 'Row 'Column)
          ptLst(mapcar 'cdr
                  (vl-remove-if-not
                    '(lambda(a)(= 10(car a)))
                            (entget(car cPl))))
          ); end setq
    (if(= :vlax-true hitRes)
      (progn
      (setq adNum(-(length ptLst)(-(vla-get-Rows vlaTab)Row))
            chT(vla-getRowHeight vlaTab Row)
            ); end setq
      (if(not(minusp adNum))
        (vla-InsertRows vlaTab Row chT adNum)
         ); end if
      (foreach itm ptLst
        (setq cStr
               (strcat(rtos(car itm)2 2)
                      ","
                      (rtos(cadr itm)2 2))
         ); end setq
        (vla-SetCellValue vlaTab Row Column cStr)
        (setq Row(1+ Row))
        ); end foreach
      ); end progn
    ); end if
  ); end if
 ); end progn
); end if
   ); end if
   (princ)
   ); end of c:tabord