Author Topic: [XDrX-PlugIn(27)] Label the coordinates along the polyline list and draw a table  (Read 806 times)

0 Members and 1 Guest are viewing this topic.

xdcad

  • Bull Frog
  • Posts: 424
The BASE64 encoded ODCL file is used. If you have problems copying it back and running it, please leave a message.



Code - Auto/Visual Lisp: [Select]
  1. (defun c:XDTB_CoordsList1 (/
  2.                            $XDOB_GLOBAL_COORDSATLINE_MASKCHECK
  3.                            $XDTB_COORDS_VAR_JD     att
  4.                            atts        bCutZ       blk
  5.                            blkna       bMakeBlk    box
  6.                            boxType     coords-odcl-data
  7.                            dimTolCtrl  div         e
  8.                            el          ept         gap
  9.                            h           HeaderBaselineType
  10.                            HeaderH     HeaderTxt   i
  11.                            iList       ilist1      inxs
  12.                            j           LeaderL     len
  13.                            lst         mask        n
  14.                            na          p1          p2
  15.                            pj          pn          pt
  16.                            pts         RowGap      RowNums
  17.                            scl         spt         ss
  18.                            startNo     str         tb
  19.                            tf          titleheight TolAngle
  20.                            TolDist     txtH        txtPrefix
  21.                            v_direct    v_next      v_prev
  22.                            value       vert-nums   x
  23.                           )
  24.   (setq coords-odcl-data
  25.          '("YWt6Ayh3AADKE8kkBuKTIxUSYilrQJW6iEYLLVkT7Ng3tdg3JNmXWADTYXbfbPm2c/fjpuguZaq4"
  26.            "IBHM0EnIZRH0bdQ6PDzGWhNUK3paVPredHY0V9Z7PBf8PnqGKW5BjN1290E6/CzuLvsGuuINiE+J"
  27.            "oOfDCVngZ0FMyEjnERgImLBDmQKZD5EiSbKg5vu8GZvrkuutlYRNTbPu/ndm/2pKvEFAhYeKSLY8"
  28.            "cn6g13smP2UGjOhfZvgwFv0IFv9dBgz8gRO5oXqQE/xwglqO8nA2PVUQC79u4Kf6mVpv2Q4RbRAL"
  29.            "mxFANSkSuJFzn8BIQlH3GVqOoR8WmBHJnxFk8ZjRNplaDoFOIUP3heyGAdSOg7MuMfPCc5YZXSZP"
  30.            "1vy8caAYO0lApXpiufiS/S/m/GKgvIRL0lDgLUanlPmbXoImGcZxhplESKaERyo1uSmludFvIGjt"
  31.            "wYFdhUadSWuCPXvB356BpJPffagYl8+cu/n3HWHynZF6EHGfGWrJuI92k7GMiC+isD94BVLwo05/"
  32.            "WW7bv4Qze6OqFsmXfhAngf3kHO028Ki1dAA4v9lqQtWeCWuCF3fRMb/5v9Mj5d9x4ZUvgvKMba3t"
  33.            "8LxXBNRRVylC2Z7k5vKB3WLhKM5b4SExRM7zj3grrRSIHk35nmZI3XvSEjcCovuo5vzx68RIiH/X"
  34.            "qfoMgld7xRYSaya7IyjhU9ckvEssrdST2CdVasMsiwQihBiDAGY+w2ceg7ecEWIIncE5W4OhO6El"
  35.            "HR0U6Au+uEPaRXkTglFEwKu4mXeJpIYvvOEukh/h/IlVBtH8X1hB2dKRHkPWiv3WlYYfNxEelu4K"
  36.            "KxjYk09xbOd62Tp4/2ZLZe46cP1S72K2bAdpGveOj9P0env3wn3/NRr95dtZ5quMgzpgWfNI4Ru4"
  37.            "NZ6ZehTKMPBnvEBlHEPLx+2PcCtRFIkPHTdSs7p/i3TnKlWajUObhglrguT8ISvO+TmFGVtiDSjH"
  38.            "gAXb2bWdZYiHoqsBLcCBKZhgZREvwIHAo2BAEM5eq31RKZI8zs4ADiYmE0kFwWKVMnDSqWuBgAM7"
  39.            "EYLMvOGm0wTxJFMmmyTEsAibxPzrQHPM64BvGlUD444hamBt0ugH2Cmvgcck03mgovfhBCzfcPhh"
  40.            "K5O9ZLqw5DgfkjyvMh1Ols527XvSwgd11ra1cFWp4S+OWWviKM4UPyEvjtk8yM5dtINyaMkt7xPt"
  41.            "/Hv1gskc7wIizrY/vA3LxytApx7ZrHCrWFFWk66mlrVepZZl+mEoEljfnvnqhYE8v/zzzZmjWkMZ"
  42.            "/ZNnOe+1+OatnPwZygh2z6tnQzny/bJvMf9xYq/bQvGyZ9WjQwU0mBlz0cJ0+wbS499QjBDjsbal"
  43.            "u3WrigzqPD+/jz5cw62eU4jAcI1glxcbA2Z0zAD23zCoE41XFenmQOo2gLFetQlqGoeov1zuUUfP"
  44.            "KPilKoeoCw0J2h7SblvKBPBte1cvTaqy1eVVXg8GQurmkRAOj1H8Qkc4bZq3iFe2jXnemY3h/FKh"
  45.            "827+AmEugsJSkUW0j0WLjVfTSG7fRazapX1wjDwwDSalkR8SqIiY26hjiaf78ALXDPqzGGpnQvDY"
  46.            "PbBBs/IgUiO4z1nWDjcDTKnyLx58bP68elWInRO5xh+8U720fZm+dyF4Q1kCdRowFvyuRx8jRzBW"
  47.            "1AX8HadXaMBAhJ0UYtcW7N9X1ZLyzLTb5SswbYjuK4yPB7ZU10HCGuvlHMy7LVu7sdKMcLwMKGcV"
  48.            "TJvzC1HjMWGCro3tl4SnxKrbt6Syi9K2TMNezbJpvnnorxnslaMnG/qjN3wdjHcY6yLXRELbG+hG"
  49.            "apTHE3KLiyKJL73l0ikw/71lq/TnnKqiy6J5Qct4iiSFQLYkRXrMqAv/oDFvzfVkSn1AFi473XQw"
  50.            "8+c86lP3JdlL855szTjbA0eY292z8osoq2oLGwbdWqF6eZUqcQ5jj4ZcZ18nd0ydkvS38g0BMrFG"
  51.            "St5VTLClnkWd5kNw1zFtPS1SpW8UUiXviDnPUnah4TVShWOOaLXEpOJA6COApO1tmQEHn8khi2zF"
  52.            "oHugHCmwUHvl8rmC8yOBcLCmy6et5rkE7tOAdHpg10jGuWMtSKUUJvwE6kOWMPhwcSQdBa7QtgH4"
  53.            "mUEhftmBYppHFkJ0yXaCmc1epZSRP8hLYLOqJmxbNNxbw3yNmkEJTkqHsYhOh+LLXdQzmo9iFW2g"
  54.            "huPYHfckh0t24qGRrJnrPUKR6Ce/3rMvz0yifvGDFPzPsNE4zYk8itUZv5cpQRglrlMud3X6vxq4"
  55.            "xNksuIwseR0hgk497VEwOCrJCg2n9W67QFtiFJJteedHAHL/uUAJlOca2s7R3O/pOPhEMaJgB5yO"
  56.            "Qo+dno66VnQEbRFaQf0Pf5rGCfygGJkkXWB9p9zw/5HAxkylBv7fsEjsALTAe+Ivpn7ahpPEuy+j"
  57.            "RnLMmscMVjaAGd7pgvVeNcB5vOtCKSxdzE3xUhAb0s3ySEFT/dUiUBFpGwe6AKKdFgMuqM9wiqgf"
  58.            "1IOvUgXjC6J1zAvCe58kOUqQIN8LEh/SzXCRDdRLqA9w4k+9f/JrrA56Xb+Xex9lP/FVjUIYv0jA"
  59.            "cJ+5cu8TKh5l5WeVEt1NlLaOjPMZvrdjQ1b4L8qZsnzn7WwKwK95TAlCeY3uEe58ExoW1J3nmT+E"
  60.            "Jimc9kLkXe+5oJg2KpP7+tk0LF4dxYQ0rFSJNKzaZkPmjNsW/CqGnRlT8gsgqqmnrGIztyC8pCOu"
  61.            "aWTJNlPuL1wt6hdkW9x3zd+pBEOzzlGoCFVjXfRUZGu624q0kLQ8CUehceKe6XxYVIjA/KPiXhJX"
  62.            "hKYSYWF/YV1WC8oqi/Bh+QSXxFiRxsjO3GWAKpmRw9JrV9nXyuua08iswMiswFqRTYS12gwiiOH7"
  63.            "VfVganLvIl4Rupahy1BNcVu5fyU48tozKARKmr8pq3HUKKlOwQDxXZx4uNj2xluy9oZuemBvhUys"
  64.            "xHZcmnzhBvfvB8t7v7xZXo5mx/L7Gfsvx1LBOMPuXJsWhLsS4D8oT0hP9sdglV39DtMMd0x2wWtR"
  65.            "TnY5uUBMdqlcangXiLJeQjUmHu7Dbkb96gNp30rIFWQL9+ZdIpgmeAeL2ccLdA2iGE15U9HsnUtN"
  66.            "Qht7pXdFGCUwnBFoMBTn/w9+h/wX8+JB/xKnwvinPzs5S0iJO+4T0GWYVVBhaPo49RDxFxMRcR9H"
  67.            "BfDpJW2nk6SHC+zFBwuaatEKTEzRp4l8JvC4Z5nt09MfIufT590Dv6hW+wvQQTsVszJnFCjyad/T"
  68.            "w3fM06/+Jb7IyMhsBQZkr9ZfcQjPyYVVy8mci13l1b6Y1pwLSR0Nu9WbKFEzinJoaJFptUcPkuVd"
  69.            "HlGS4W0opzTrJ1BKsRsPKJ9GXCynX9h3LByFJOc8FNegT/+s3GzlqY8e/3EhXMJ2VOyheOd7BwAF"
  70.            "5/Ta13AnojQUzfWxbojDXLcHwb64wkwmzhIC0QdjiSKX46c6u0s09CSVF/qEQPjzcCGj+X8SD3NH"
  71.            "gyGExrcvVoibBRJj1rShxgRJoewCf9ybw/KuyYmmGYzrABsh9+FT+o9WJDwrmZXXwlcUh11PJ1kn"
  72.            "xdCkBujQAT3H4N4ToX4npRa/SEENJWkTVY1QvE7FcKzK7dZohHKJb7w/UcxGOem8y9pGHS1T11M0"
  73.            "qYOLwaj98cOupXSFGBSETU2pMMmJUd6J0AawkGwCkbSrgYQmtR0RRdmJ0AZDL/+VUP3BIrnG3EtL"
  74.            "tYP7at1J2xURHNblt6+f2XGbi2Xr54p9tq49ZsrwjGXW9R+44RdYg1XeqeODXpVwwYECdcEZzB4N"
  75.            "qgv7kEyb1piPZb945gXoPnAqeZxmNg9V4YfK6ojL6oiHSQXd7CJXoWhRx2zBk1smW/GJsoWhwjRr"
  76.            "WgTyqfNEtFIXHIjWHszOdVjCXIIIuJhrn2NV70ovNwxkEem9eQYsFoJqaWM39wjE6FIX0QQTqQyb"
  77.            "nCAPAIOrPSlRIuSCXgOHkobnQUKBqLcN/cEFkJxt6eHDhrqlvQ706E/Q4aOt6eeHNpgNeVFjxMOJ"
  78.            "pP7xlbKNpAwbgGynDwAZTvJ2uOuVQ7I6m2uNSiI3aWjH7F3efinmmZ1MCRBK0U4h4svk7IUhveBD"
  79.            "+4GBcSBvO5c="
  80.           )
  81.   )
  82.   (defun c:CoordList1#OnInitialize (/)
  83.     (if (not $XDOB_GLOBAL_COORDSATLINE_MASKCHECK)
  84.       (setq $XDOB_GLOBAL_COORDSATLINE_MASKCHECK 0)
  85.     )
  86.     (dcl-Control-SetFocus CoordList1-check-dim-control)
  87.     (dcl-Control-ZOrder CoordList1-check-dim-control 1)
  88.     (if #coords_data
  89.       (progn (setq txtH       (cadr (assoc "TxtH" #coords_data))
  90.                    HeaderH    (cadr (assoc "HeaderH" #coords_data))
  91.                    HeaderTxt  (cadr (assoc "HeaderTxt" #coords_data))
  92.                    txtPrefix  (cadr (assoc "TxtPrefix" #coords_data))
  93.                    LeaderL    (cadr (assoc "LeaderL" #coords_data))
  94.                    RowNums    (cadr (assoc "RowNums" #coords_data))
  95.                    RowGap     (cadr (assoc "RowGap" #coords_data))
  96.                    boxType    (cadr (assoc "BoxType" #coords_data))
  97.                    dimTolCtrl (cadr (assoc "DimToCtrl" #coords_data))
  98.                    TolDist    (cadr (assoc "TolDist" #coords_data))
  99.                    TolAngle   (cadr (assoc "TolAngle" #coords_data))
  100.                    bMakeBlk   (cadr (assoc "bMakeBlk" #coords_data))
  101.                    bCutZ      (cadr (assoc "bCutZ" #coords_data))
  102.                    scl        (cadr (assoc "scale" #coords_data))
  103.              )
  104.              (dcl-Control-SetText CoordList1-txtheight txtH)
  105.              (dcl-Control-SetText CoordList1-table-title-height HeaderH)
  106.              (dcl-Control-SetText CoordList1-scale HeaderTxt)
  107.              (dcl-Control-SetText CoordList1-prefix txtPrefix)
  108.              (dcl-Control-SetText CoordList1-leaderlen LeaderL)
  109.              (dcl-Control-SetCurrentSelection
  110.                CoordList1-box-type
  111.                boxType
  112.              )
  113.              (dcl-Control-SetText CoordList1-scale scl)
  114.              (dcl-Control-SetValue
  115.                CoordList1-check-dim-control
  116.                dimTolCtrl
  117.              )
  118.              (dcl-Control-SetText CoordList1-dim-dist TolDist)
  119.              (dcl-Control-SetText CoordList1-dim-angle TolAngle)
  120.              (dcl-Control-SetValue CoordList1-check-insert bMakeBlk)
  121.              (dcl-Control-SetValue CoordList1-cutz bCutZ)
  122.       )
  123.       (dcl-Control-SetText
  124.         CoordList1-scale
  125.         (rtos (xd::var:getscaleratio) 2 1)
  126.       )
  127.     )
  128.   )
  129.   (defun c:xdtb_coordslist/CoordList1/CheckBox2#OnClicked (Value /)
  130.     (if (= value 1)
  131.       (progn (dcl-Control-SetEnabled CoordList1-dim-dist t)
  132.              (dcl-Control-SetEnabled CoordList1-dim-angle t)
  133.              (dcl-Control-SetEnabled CoordList1-dim-dist-label t)
  134.              (dcl-Control-SetEnabled CoordList1-dim-angle-label t)
  135.              (dcl-Control-SetEnabled CoordList1-dim-points-label t)
  136.              (dcl-Control-SetEnabled CoordList1-dim-point-nums t)
  137.       )
  138.       (progn (dcl-Control-SetEnabled CoordList1-dim-dist nil)
  139.              (dcl-Control-SetEnabled CoordList1-dim-angle nil)
  140.              (dcl-Control-SetEnabled CoordList1-dim-dist-label nil)
  141.              (dcl-Control-SetEnabled CoordList1-dim-angle-label nil)
  142.              (dcl-Control-SetEnabled CoordList1-dim-points-label nil)
  143.              (dcl-Control-SetEnabled CoordList1-dim-point-nums nil)
  144.       )
  145.     )
  146.     (princ)
  147.   )
  148.   (defun _gettxt (str)
  149.     (setq str (rtos str 2 $XDTB_COORDS_VAR_JD))
  150.     (if (= (atof str) 0)
  151.       (setq str "0.0")
  152.     )
  153.     str
  154.   )
  155.   (defun _drawtable (lst / i)
  156.     (xdrx_statusbar_begin "Table Making" (length lst))
  157.     (setq i 0)
  158.     (setq lst (mapcar
  159.                 '(lambda (x)
  160.                    (xdrx_statusbar_setpos i)
  161.                    (if (= bcutz 0)
  162.                      (list
  163.                        (strcat (strcase txtPrefix)
  164.                                (itoa (+ (1- (atoi startNo)) (setq i (1+ i))))
  165.                        )
  166.                        (_gettxt (cadr x))
  167.                        (_gettxt (car x))
  168.                        (_gettxt (last x))
  169.                      )
  170.                      (list
  171.                        (strcat (strcase txtPrefix)
  172.                                (itoa (+ (1- (atoi startNo)) (setq i (1+ i))))
  173.                        )
  174.                        (_gettxt (cadr x))
  175.                        (_gettxt (car x))
  176.                      )
  177.                    )
  178.                  )
  179.                 lst
  180.               )
  181.           lst (if (= bcutz 0)
  182.                 (append (list (list headerTxt nil nil nil)
  183.                               (list "No" "Coords X" "Coords Y" "Coords Z")
  184.                         )
  185.                         lst
  186.                 )
  187.                 (append (list (list headerTxt nil nil)
  188.                               (list "No" "Coords X" "Coords Y")
  189.                         )
  190.                         lst
  191.                 )
  192.               )
  193.     )
  194.     (xdrx_statusbar_end)
  195.     (xd::text:init 1)
  196.     (if (setq pt (getpoint "\nTable Insert Position<&#36864;&#20986;>:"))
  197.       (progn (setq tb (xd::table:makefromlist
  198.                         lst
  199.                         (trans pt 1 0)
  200.                         (setq h (* (atof scl) (atof txth)))
  201.                         (* (atof scl) (atof RowGap))
  202.                       )
  203.              )
  204.              (if (/= txth titleheight)
  205.                (xdrx_table_settextheight
  206.                  tb
  207.                  0
  208.                  0
  209.                  (* (atof scl) (atof titleheight))
  210.                )
  211.              )
  212.              (if (= 1 bMakeBlk)
  213.                (xd::table->block tb)
  214.              )
  215.       )
  216.     )
  217.     (if (= 1 mask)
  218.       (progn)
  219.     )
  220.     (princ)
  221.   )
  222.   (defun _makeLineblk (len txth gap / att blk blkna el)
  223.     (if (not
  224.           (setq blkna (xdrx_object_get "block" "XD_INDEX_LINE_BLK"))
  225.         )
  226.       (progn (setq el (xdrx_line_make '(0.0 0.0 0.0) (list len 0.0 0.0)))
  227.              ($XDLSP_SETTEXTSTYLE "ht" "&#40657;&#20307;" 0.8)
  228.              (xdrx_text_make
  229.                (list (+ len gap) 0.0 0.0)
  230.                "A"
  231.                (* (atof scl) txth)
  232.                0.0
  233.              )
  234.              (XD::Text:AdjustAlignMent (entlast) 0 2)
  235.              (setq att (xdrx_attributedef_make (entlast) t))
  236.              (xdrx_block_make
  237.                "XD_INDEX_LINE_BLK"
  238.                (list el att)
  239.                '(0 0 0)
  240.                t
  241.              )
  242.       )
  243.     )
  244.     blk
  245.   )
  246.   (defun _process ()
  247.     (if (not $XDTB_COORDS_VAR_JD)
  248.       (setq $XDTB_COORDS_VAR_JD 4)
  249.     )
  250.     (if (and (setq e
  251.                     (car
  252.                       (xdrx_entsel
  253.                         "\nPlease Pick the Polyline<Exit>:"
  254.                         '((0 . "*polyline"))
  255.                       )
  256.                     )
  257.              )
  258.              (xdrx_setpropertyvalue e "closed" t)
  259.              (setq iList (xd::list:removedup
  260.                            (xdrx_getpropertyvalue e "vertices")
  261.                          )
  262.                    pts   iList
  263.                    i     (1- (atoi startNo))
  264.              )
  265.         )
  266.       (progn
  267.         (xdrx_begin)
  268.         (xdrx_sysvar_push '("dimzin" 0))
  269.         (if (xdrx_object_isa e "AcDb2dPolyline")
  270.           (xdrx_polyline_convertfrom e)
  271.         )
  272.         (setq pj '(0 0 0))
  273.         (setq tf (xd::doc:safezoom e))
  274.         (if (setq ss (ssget "f"
  275.                             (xd::list:removedup iList)
  276.                             '((-4 . "<or")
  277.                               (0 . "MULTILEADER")
  278.                               (2 . "XDTB_COORDS_LIST*,XMLEADER-*")
  279.                               (-3 ("xd-mleader"))
  280.                               (-4 . "or>")
  281.                              )
  282.                      )
  283.             )
  284.           (progn
  285.             (mapcar
  286.               '(lambda (x)
  287.                  (setq temp x)
  288.                  (if (xdrx_object_iskindof x "insert")
  289.                    (progn (if (not (setq atts (xdrx_getpropertyvalue
  290.                                                 x
  291.                                                 "attributeEntities"
  292.                                               )
  293.                                          x    (car atts)
  294.                                    )
  295.                               )
  296.                             (setq x (car (xdrx_block_getentities temp)))
  297.                           )
  298.                    )
  299.                  )
  300.                  (if (xdrx_string_find
  301.                        (strcase (xdrx_getpropertyvalue x "textstring"))
  302.                        (strcase txtPrefix)
  303.                      )
  304.                    (xdrx_entity_delete temp)
  305.                  )
  306.                )
  307.               (xdrx_pickset->ents ss)
  308.             )
  309.           )
  310.         )
  311.         (if (= boxType 0)
  312.           (setq na ($XDLSP_POLYGON_ZBYX_BLK (atof LeaderL) (atof txtH)))
  313.         )
  314.         (if (= dimTolCtrl 1)
  315.           (progn
  316.             (if (and (/= vert-nums "")
  317.                      (> (abs (setq vert-nums (atoi vert-nums))) 1)
  318.                 )
  319.               (progn (if (> vert-nums (length ilist))
  320.                        (setq vert-nums (length ilist))
  321.                      )
  322.                      (setq i 0
  323.                            div
  324.                             (fix (+ 0.5 (/ (length ilist) (abs vert-nums) 1.0))
  325.                             )
  326.                            ilist1 nil
  327.                            inxs nil
  328.                      )
  329.                      (foreach n ilist
  330.                        (if (and (= 0 (rem i div))
  331.                                 (< (length ilist1) (abs vert-nums))
  332.                            )
  333.                          (setq ilist1 (cons (setq pt (nth i ilist)) ilist1)
  334.                                inxs   (cons (vl-position pt iList) inxs)
  335.                          )
  336.                        )
  337.                        (setq i (1+ i))
  338.                      )
  339.                      (setq pts  (reverse ilist1)
  340.                            inxs (reverse inxs)
  341.                      )
  342.                      (if (< vert-nums 0)
  343.                        (setq ilist pts)
  344.                      )
  345.               )
  346.               (progn (setq pts (xd::pnts:diluting
  347.                                  ilist
  348.                                  (atof TolDist)
  349.                                  (atof TolAngle)
  350.                                )
  351.                      )
  352.               )
  353.             )
  354.           )
  355.         )
  356.         (setq txtPrefix (strcase txtPrefix))
  357.         (xd::text:init 1)
  358.         (setq i -1
  359.               j 0
  360.         )
  361.         (xdrx_statusbar_begin "Data Collection" (length pts))
  362.         (xdrx_setmark)
  363.         (foreach n pts
  364.           (setq i (1+ i))
  365.           (if (= dimTolCtrl 1)
  366.             (progn
  367.               (cond ((= vert-nums 0) (setq i (vl-position n ilist)))
  368.                     (t (setq i (nth j inxs)))
  369.               )
  370.             )
  371.           )
  372.           (setq pn       (xdrx_getpropertyvalue e "prevnextindex" i)
  373.                 p1       (xdrx_polyline_getpointat e (car pn))
  374.                 p2       (xdrx_polyline_getpointat e (cadr pn))
  375.                 v_next   (xdrx_vector_normalize
  376.                            (xdrx_getpropertyvalue e "firstderiv" n)
  377.                          )
  378.                 v_prev   (xdrx_vector_normalize
  379.                            (xdrx_getpropertyvalue e "firstderiv-" n)
  380.                          )
  381.                 v_direct (if (xdrx_vector_iscodirectional
  382.                                v_next
  383.                                (xdrx_vector_negate v_prev)
  384.                                1e-3
  385.                              )
  386.                            (xdrx_vector_perpvector v_next)
  387.                            (xdrx_vector_normalize (mapcar '+ v_next v_prev))
  388.                          )
  389.           )
  390.           (if (= (xdrx_point_getRelationAtClosedCurve
  391.                    (mapcar '+ n v_direct)
  392.                    e
  393.                  )
  394.                  2
  395.               )
  396.             (setq v_direct (xdrx_vector_negate v_direct))
  397.           )
  398.           (if (= dimTolCtrl 1)
  399.             (progn
  400.               (cond ((< vert-nums 0) (setq i j))
  401.                     ((= vert-nums 0) (setq i (vl-position n ilist)))
  402.               )
  403.             )
  404.           )
  405.           (setq spt n
  406.                 ept (mapcar '+
  407.                             n
  408.                             (xdrx_vector_product
  409.                               v_direct
  410.                               (* (atof scl) (atof leaderl))
  411.                             )
  412.                     )
  413.                 str (strcat txtPrefix (itoa (+ (1- (atoi startNo)) (1+ i))))
  414.           )
  415.           (if (= boxType 0)
  416.             (XD::DimLeaderIndex:Make
  417.               str
  418.               (atof txth)
  419.               spt
  420.               ept
  421.               1.0
  422.               "_none"
  423.               0
  424.             )
  425.             (progn                      ;(setq lxd1 n lxd2 v_direct lxd3 (* (atof scl) (atof leaderl)) lxd4 0.0 lxd5 str lxd6 (* (atof scl) (atof txth)))
  426.               (setq txth1 (* (atof scl) (atof txth)))
  427.               (xd::mleader:make
  428.                 n
  429.                 v_direct
  430.                 (* (atof scl) (atof leaderl))
  431.                 (/ txth1 3.0)
  432.                 str
  433.                 txth1
  434.               )
  435.             )
  436.           )
  437.           (if (= 1 bMakeBlk)
  438.             (progn
  439.               (setq
  440.                 str (strcat "XMLEADER-"
  441.                             (xdrx_getpropertyvalue (entlast) "handle")
  442.                     )
  443.               )
  444.               (xdrx_block_make
  445.                 str
  446.                 (entlast)
  447.                 (xdrx_getpropertyvalue (entlast) "firstvertex" 0)
  448.                 t
  449.               )
  450.             )
  451.           )
  452.           (setq j (1+ j))
  453.           (xdrx_statusbar_setpos j)
  454.         )
  455.         (xdrx_statusbar_end)
  456.         (_drawtable ilist)              ;       (xd::drag:simplemove (entlast)
  457.                                         ; "\n&#25554;&#20837;&#28857;<&#36864;&#20986;>:" 8 t)
  458.         (xdrx_entity_setproperty
  459.           (xdrx_getss 9)
  460.           "layer"
  461.           "coordinate"
  462.         )
  463.         (xdrx_prompt "\nMarked " (length ilist) " Point.") ;(and tf
  464.                                         ;     (xdrx_document_zoomprevious))
  465.         (xdrx_end)
  466.         (princ)
  467.       )
  468.     )
  469.   )
  470.   (defun c:CoordList1-button-ok#OnClicked (/)
  471.     (setq txtH        (dcl-Control-GetText CoordList1-txtheight)
  472.           HeaderH     (dcl-Control-GetText CoordList1-table-title-height)
  473.           HeaderTxt   (dcl-Control-GetText CoordList1-content)
  474.           txtPrefix   (dcl-Control-GetText CoordList1-prefix)
  475.           LeaderL     (dcl-Control-GetText CoordList1-leaderlen) ;
  476.                                         ; HeaderBaselineType
  477.                                         ; (dcl-Control-GetCurrentSelection
  478.                                         ; xdtb_coordslist/CoordList1/OptionL
  479.                                         ; ist2)
  480.           RowNums     (dcl-Control-GetText CoordList1-Table-fenlan)
  481.           RowGap      (dcl-Control-GetText CoordList1-table-cellmargin)
  482.                                         ;
  483.                                         ; mask (dcl-Control-GetValue
  484.                                         ; CoordList1-check-insert)
  485.           boxType     (dcl-Control-GetCurrentSelection CoordList1-box-type)
  486.           dimTolCtrl  (dcl-Control-GetValue CoordList1-check-dim-control)
  487.           TolDist     (dcl-Control-GetText CoordList1-dim-dist)
  488.           TolAngle    (dcl-Control-GetText CoordList1-dim-angle)
  489.           startNo     (dcl-Control-GetText CoordList1-start)
  490.           bMakeBlk    (dcl-Control-GetValue CoordList1-check-insert)
  491.           bCutZ       (dcl-Control-GetValue CoordList1-cutz)
  492.           titleHeight (dcl-Control-GetText CoordList1-table-title-height)
  493.           vert-nums   (dcl-Control-GetText CoordList1-dim-point-nums)
  494.           scl         (dcl-Control-GetText CoordList1-scale)
  495.     )
  496.     (setq #coords_data
  497.            (list (list "TxtH" txtH)
  498.                  (list "HeaderH" HeaderH)
  499.                  (list "HeaderTxt" HeaderTxt)
  500.                  (list "TxtPrefix" txtPrefix)
  501.                  (list "LeaderL" LeaderL)
  502.                  (list "HeaderBaseLineType" HeaderBaselineType)
  503.                  (list "RowNums" RowNums)
  504.                  (list "DimToCtrl" dimTolCtrl)
  505.                  (list "BoxType" boxType)
  506.                  (list "Mask" mask)
  507.                  (list "TolDist" TolDist)
  508.                  (list "TolAngle" tolAngle)
  509.                  (list "StartNo" startNo)
  510.                  (list "bMakeBlk" bMakeBlk)
  511.                  (list "bCutZ" bCutz)
  512.                  (list "TitleHeight" titleHeight)
  513.                  (list "scale" scl)
  514.            )
  515.     )
  516.     (cond ((= "" HeaderTxt)
  517.            (dcl_MessageBox
  518.              "Title Content Cannot be Empty."
  519.              "XD Tips"
  520.              2
  521.              2
  522.            )
  523.           )
  524.           ((= "" startNo)
  525.            (dcl_MessageBox
  526.              "Start Number Content cannot be Empty."
  527.              "XD Tips"
  528.              2
  529.              2
  530.            )
  531.           )
  532.           (t (dcl_sendstring "(_process)\n"))
  533.     )
  534.   )
  535.  
  536.  
  537.   (defun c:CoordList1-button-quit#OnClicked (/)
  538.     (dcl_Form_close CoordList1)
  539.     (princ)
  540.   )
  541.   (xd::doc:checkacadversion '>= "2008" "")
  542.   (dcl_Project_import coords-odcl-data)
  543.   (dcl_Form_Show CoordList1)
  544.   (setq box (xdrx_drawing_pixelbox))
  545.   (dcl_Form_SetPos
  546.     CoordList1
  547.     (car (last box))
  548.     (cadr (last box))
  549.   )
  550.   (dcl-Control-SetFocus CoordList1-check-dim-control)
  551.   (dcl-Control-ZOrder CoordList1-check-dim-control 1)
  552.   (dcl-Control-SetFocus CoordList1)
  553.   (princ)
  554. )
  555.  
« Last Edit: December 03, 2023, 12:19:45 AM by xdcad »
The code I wrote uses XDRX-API,which can be downloaded from github.com and is updated at any time.
===================================
[XDrx-Sub Forum]
https://www.theswamp.org/index.php?board=78.0
https://github.com/xdcad/XDrx-API
http://bbs.xdcad.net