VBA-如何删除所有行
你好问题1.我不知道该怎么做。我需要删除一个图层上的数百行。我需要在VBA中执行此操作。我不想使用选择。只需删除层上的所有行。
问题2。与问题1相同,但有一个关于颜色的条件(即,如果红色删除)。
谢谢 你好,Katto01,
下面是一些示例代码,可以帮助您继续。
删除“Layer1”层上的所有行:
删除“Layer1”层上的所有红线:
这应该能让你继续前进。如果你想用很多层重复这个过程,你可以在一个对话框中输入层和颜色,并使用输入的值进行删除。
本 本,谢谢你的帮助
在这两种情况下,行“For Each oLine In ThisDrawing.ModelSpace”给出了错误“type mismatch”。我在AutoCAD 2011 您可以尝试选择集方法
2
katto01,
我只能在我的电脑上返回到2012版本,但代码在那里运行良好。
不要将代码复制并粘贴到VBA编辑器中,而是尝试逐行键入代码,在声明变量“oLine”时,要特别注意AutoCAD提供的功能。您应该看到:
https://www.cadtutor.net/forum/image/png;base64,Ivborw0kgoaaaansuheugaaafwaaae8caiaacq2jtwaaaagaeleqvr4no2dz67ruh2a+sxdfv0fmb3fig8q3pwawf11mev4kz1xnaaztcdp2i4g3qwcnr1p5571yia2u2dsfqmmzvicf34digj4l9zth1s2fw+EPceyxRFyed8+uknmRS/GzkcDp//7r8wfigemjasdkiictyfs9s/tav0nlf1+k/DItZkn546Lyq5//xV/+/bf1/mlk9okn99mjn991 8DV3X3xlfvzxp/nZr7774qvvfrWw/Ovp5e+C8j+Lyr/Vlb9fWvaZ8vtF5ekC5U9Pv//T078Xy68vXt755ftfv/v+N69a/vD9b/7w/T8Uy58vVX77hz//9j9qy/9WlX/0y3+eX7q0/FOpfH2x8s9T+b98eZ8v4mTpW4v0T5W++eMv1E/ET//mNaT/1z8V4qfb/mekj/SRPtK/pPRvYvzHkP4v58P8syL9qSB9pI/0kf5lpP/5mOG5vvGRPtJH+kgf6d9A+jcsSB/pI32kj/SRPtJH+kgf6SN9pI/0kT7SR/PIPYT9AABJA+AEBDIH0AGIAOKP4TADCOXXSFAAPDMTFQTAADCLUGAKD4AQEMGFQCAHH+KYQBV XVAELEP6CFOKY3G+vzfyGOi2D/GEANMF0JDKXM6XUIANGATK/whr6QcAwK04WfqR8/UXJOILC9LVRWEEOP4QXSLBGZLVSRQHG51HR6SFO2MVTR3KJUSGZVY30AAJ1TPR/pczwFBItT6ZtJ9L2x4+sAdyrpTw7K2DBvNNUtr+Xa9CqOZwqvAwAADXKq9MNAf3rluziRfnBKGP3rYv8gbI+d7l8oullles3f9h5xcfubog0uin0vz+knuyqkn9xfzqbysftlayf9iacf0jvrp6d4vka9m6i7i1fd36kvsjoexaai1x/o3cy2skqj/oobubmQPCv9+buk0ifqb4dgof2rxofer9b0i3zaab1lvflrcwet1+vnwfhy1ka0dwmwaa0bbihwc1 Giza+AEBDIH0AgIaok/4LAADcMxXSv/X5CQAAzqVC+gAAcO8gfQCAhgik/wQAAA9NLP23AADwuGSkf9aFgxC3vksBAABFkD4AQEMgfQCAhkD6AAANgfQBABoC6QMANMTNpG/URoiNEBshn8/cB6M2Un84s5GUTm+HHopzu+qayvaztv+vtL8A0AK3kb5RG6H2/c+D3I6RQZA7689Z2ONTPNFUWZ53FGPAUZQOT4ACHFCQVJPY3AKGO13AIX13XO3RTBBCBRZXLG3G6A25KIWKTXF7BHX1MPXBR8RQEDPVK7/DYH2WsNTvX1WL/49aCJaX++1DCWM7WAG1Z9CVHB4GBSZWS8ZTCV0DJZCFSPS/PRLJpg1p6WjQ7dyXR6a1/DJGAD08ZNIJG75ZNIJG75ZNFCS 5L7/TuWXqSnen/zBbT5fGVUHj+yLZDpA8AS1id9P0otdNbz6eLpd89y9GYQ/NqipSn9seNLuhqGOm7rSTh/Ez/M/0sLs9tbq5+V2MKDWDHWVF6X1RR8HDXBVIP8EQ2AKSP9P/mdaQPgBcjXXdyNUySKT4Ipt8anbiWNoklO/k0DOl7/rjpYn2ysuwz/Q/28/s8vd5nl0s8qvetvrf4wma4fjxi5tabpwahpqm1gbsg7b7ft1gett4xublkhv3ycde/Yx88im2JnZdgr9L/Wz3P/gRrQz/lz93PEBAIhZ15ezovTI3XHv/QeAh2dF0p9i27O/rnUT7r3/ANACK5I+AAC8NpeX/gyaanykkt4aqemqcahkd6aaangfqbaboc6qmanatsbockpanaqpanaqpanaqpanaqp QSB8AOCGQPGBAQYB9AICGQPOAA2B9EAGGLAWA0BNIHAGGIPA8A0BBIHWCGIZA+AEBDIH0AgIZA+GAADYH0AQAA4MBS13Ijxeaijva7JZ9NAHQ1EWKRU8X71GKPJRZVIYMNMOUA0PQBFWLy4O2wqYyeJtd0vlXQktvJzotj3YbAO6B20i/01upP/Q/G7URs9K31mpZI31rrVGTLY1aqM4u8Fyw1KjSO5lupcv9LnRaHve+tdktXg//AOYXAMBdcnvp+wuf2prmmwojxmbv0xkrzbpsrwwrp2hoyl+xcBiXmzEu+0VCbv4KXST8Lkvnd9X5RS2aA+L/3g2mn8e9bf7lrb2160wvh/7XMtkEcE+wEOwgvSOF+z3ejsoj U5XU86XU756L2B0JOQO4DHZP2ZINULMS753FSZH6A6H0M9VGO3DAOUFG1QRSN26VAI+Htcc+z+5vf/7olxi1IKw3KpO1AoA74/Y3cju9dd6fkb4voaBalqz041x/HOFm7eyqpCK8iPRL4s5LP9wFvz9TS27N+f2dyR91mUDfZsN/ALg3bi99a/dqjNzL0t+G+ZI66Y/AZUTRPVLCFPCW56XY6W/lgtiLWDdb0VvMWz+4v0AZrkJtLfKz8v3z1LtR9+dLn+7LKGOX0VC1SD3PLEZCOEONH0OW0E/6N3Drp+YCPZHKDY9UPLY/c3eKSe8APCy3kv6Y0I9uzHbe3Vq96+/l9o9sKrXN1M+SPDXCNEJ6THZQC6HM1EHVOLDH6I5XV9Toun30ku23hf5g8bsxtbkxxrm4vpss8bvh7jmljfubcp4buqcpyhrso3ahlvij49sajwosp8r8ep3s6mzl2cbpcrihwcgiza+AEBDIH0AgIZA+gaadyh0aqaaaukdadqe0gcaaaikdwdqegfakakhd4aqemgfqcahkd6aaangfqbaboc6qmanatsbwbockqpanaqsb8aocgqpgbaqyb9aicgqpoaa2b9aeagglpawa0xcnkv9ns+CgTvm+UkLq7/hanmtnok2531glhjc6f+E+mfaoa8baeetpw2unmqxrvbr7zlhbzh1cj9nk5ljharwha+p5lMpFmv0hK1YfnQ7R+/CThXU0ElbPSz0a4/UKlVKYd/2ilngzf6fqsweenhqsur5sqtzo9i/Uk7VJ9r//kih2afdge9ev Ngol1b9zxmqdtct76wnqom8r38kykn8robtl616/YaXnc+8a4/mo57avfplELzh+FdvyLpU7LyfD5+n4ek0jvpl0gcud9ifxfruj0k/e9kVfK/2pJbdmfE9iwZVHuIpX27/PsCDHlW8nDTWP1I8OGTU8WQKKD3BMPB+ZJmrST+quFT6M5LNE9whLnY+vCKpaafUn0J9pA+WYLQQFHT2N39MP0SOFES0Q98ZSE3QP8WIVOZH4AKDSL+EFMWFP346JPEAVGPJYJ9JD3IYSHJM7JKYOZ55264XTOF7OFSGHZW1U57XPTJLCTHPBUH4B7CCQZ43VHKJV1VQQRMXAIPVX7BVN6QVZJWN9/HEAGVYINIHAIACSB8AOCGQP9 GBAQYB9AICGQOPXTMFHQDCEZ9++ulplkD6D8XhcLh1FwDg1Xl6ekL6YC3SB7hDXip5+/Yt0ocBpA9wd7y8vCyv3Fsa6Yd0z1JsxFR2yXj6G6k/XH67x8bTvwJLpL+KzwgARnrpL3Qs0i9gdkLtp58T77/ilm86nn4k/u2cemikiytwf96qtwbgkf5l8kvbae3fwjf6w0f/k+Rfn9ZILeqvyYwu+zfqurvepr5ceehqzcstx7ywok4+m7Fcb34+uJVPr+y974VoiNEO6TKn9k58/01Q3jLXf+om1ncsm2anya0r8eofrl54dx9bmug2wma4joby88nn5hnpkott+bW48/f78MY4QF/UzK30/xnfGdzF+8smzsqkzl1usbxqpqp kp4lqjw+fParHZH+CePpF8e7t+EAxgvG05/NH5Wk//XXX/fed8bvl9ii9puhmkonuquwkwq1zstsp1rpquwfysyxntzlfvtixignyoyxpcygq/mJmLX816Y8VZ8e7H1fwFs+Op3+q9cfvey9tsfrj8fekmeycd8vyrfdMOTp6RvquZXftIm9nVwxGhAe6CrPRdxIf0lxFIf6/CHP250q8dT788Tv3YWj+PrN9iOZt+hvR70fs/24l0pyhvnfwpppfvcpx8w/fn0tjsryrzcuc3ur+4A5JpR9d6SP9Y8SPbG5GDexVuFyInXGV1d6aXX+Pt7/fe7nx9ofgr9xjlewwo/3kDaw1T6fmgf0b+b+8i6zNYLU594fcpod5BxUfo+wv2s421mv0f6cide0k81ijzv0b I/2H4HKPeUbS740uhMhKf3wz+CI63IXBGZ96J6VP3API38MWNRMDNWKD3CIN3IBONLA8UP40HDCIM1GWnurpfPavhxwij7C9XTJ7ZRE5U5/9A3bTQ80nZDTz2b3j7R5dHWAOwHpw+kc0kjf876/vGT83Azbzqnx0zttgih4qgzchdy9exjnxjvlxxtm7s60oc7bond6wsk33s/h1t8q94CgEX6cA6H3Ng7pQ+fdwtgdsb9oj2s9afgzby8vdzvgprhaukd3b1v60h6hcm9l9rqgjbv/zLv9f8t/+zrfox6cpaxqnzyuavqkfcr3yhk41vms4rheukp/mzfaoqpovy1ukd2crsb92ehuifqrlyovih84ilb7/UhybRCWK9N9b+/TlWb/QTx/t+3f2ky/tj9Z+Fr2bXUihNFaI9OEsstJfPolKEOm/s+9/sD9+e9Yv9Jz0KRQKkT6cSUn6CydR8SP9p4/26Uv7/qN94/2CVH9RDLCAX9OF XYXV3YXVPTR3SYL9L+2PH+3TD+V2OGFQHrcQ6cNZzEh/ysqq6t/pf3xo33zuf3sh8nCQ9j+uf3knbUf7Rs/+Np/TN3ffDOWrtM+tzbznuhbefgvt7f/46RQXqMQ6cNZzEv/6CQqLtJ/861n4v64x1i078d33vfux0/Xe9n/07Cu8J9ikPWoj04SxS6YuaSVRcpP/0MWjWJWHeJL+yn/2qvpmepvwoncp9nznvvmo6yxe+nAWkfR7o4vFk6gMkX7o9xlxv3cp+FDWl4r0ie4pD1+I9OEsfOn3d2yrJlHpI/033wZ3U12GZ8rp92pOZN0H46fl9FPpB+3kLjIolAcoRPpwFoc00q+ZRKWP9J8+ZL6XUJR0ZTVVH1FUWD1PREFUOXQ+PROwA/HPZ9UJKJ5VCKEEKMEADGIIN9UTGJCT/IpVCuXL5Roh9PfyEMrQwBkfR7Sh9KupyxdyiUK5c+0rdMogKnkZX+coj0kzqrfxfi304htolv4axxfmxf1v7f+lfAC03QoRF7S/VeKe3cePy+eR2lDm7Q0aJkTOlDwDXB+lfBi13k067Z3k56VtrO72V+sPU+ens79u5gpstdtdyajhdika9wdz5f6gxvqbnyfllkfzgr9qk/jfh8bl7fy7n7fene7fz4h23xqomyqmut7oz2lqk H6WSX9M98UF9CH5YRN01/MZAYBLJTXL4ETUY16XZBWMZ3TF9EROBD8CNDE8S/b1/INGNGDXLLZQ9FWKSVV9ZDJ7I7ZSQFW1RRVFC6MNLOENXTQICANNWDDYL0IM0K+SPEZtnUKt2R11rqMY6XcubN94+fqkmtfOdHY52oFOy/Bc1Ive/zmvv9shjtejcqo7xrzep2wqpnp/+ybva3fnnlbghq632knyhi6fdcxvoreywmbj2h31j6yydrctbkxwevgelf3arai9brfeprppzmtk31ixtrbwxi8+Q/rAt/45u9yxFkN7x6u/V+fad9k3v0pewqvso7zmepvgf6xunqmt754tgpd6wben4bgavgpjpn9pkbw5xaidcpwjbf9f2rgmlh36fhyvbgsaksak2ru Qpu+0o/x7tzug1lh4jh8fcmtcfys7eb22vcp7i9j8idcafxo53gi8h+15uY2i8/Mhm7SQqwYak7nyl+q4dEj9e/id9c+zyiuklb5wxsfdjvhb02yhh+McrY3SiS94joB1kat8Q9E+uCYl/7RSVQcnbumcNY/IktXzztNLMzp++9OP/t3FPw209ac7BPTT/tRbg1gBdR6H+nDQCp9P7Q/OonKSHTLdErCpAl+7zIjMbjz64nS9/G2nYn8/UxUcP95FHy5NYBbU2v8A5E+OCLp90YXiydRGQj9Xha3F1MHsr5UpF+Ix5PWOi29e86+9P1In+ge1kut95E+DPjSF6J6EpWe+CMH1PR9J7GSK0I7IQDFFGO9G915Q3DW+r+TsEF3gSFeCi1Br/QKQPjkMa6ddMomKtzTwZOmkyfnpnSgO5B3X8xcHTOyHKHJV+5mGhTJ20z0b1G45XLLQGsAJqvY/0YSAjfVExicq9EpyniOThzqg1/oFIHxyR9HtKH8pjfFj+A5/wwwqqp90it95e+DGSlDwBrptb4ByL96zMNmZkbrN9/95RHRoLHCzMNzISySB/gHqn1PtK/DfkReM4YXt/HnDTsDdIHuDtqjX8g0r8VqfTjK4AF9p8fHz/ZokwfQOkXKqUEM2cB3Ce13kf6t+H8SP/o+pif7cbfje207m8z6tf1gcesh5qjx8g0r8v50p/wVDJpfVS6fctRdJnEhWAu6DW+0j/NlxN+lhfkun7lwwtqacsj1rjh4j0b8ul0jthxscfn3sww 9JLEBWDL1HOF6V+b0iOb/qD56aOcGY6Njx++lb4RjHGgTFH6TKKSb206opxF4GbUGv9ApA+OGekziUrSWnC+QPtwQ2q9j/RhYF76TKKSdJV7AnB7ao1/INIHRYP9WSQQM5OOEMEYN+4IbXeR/owEEm/N7pgEpWjk6gQ9MPtqDX+gUgfHL70+zu2TKJSnEQlSvkgfbgdtd5H+jbwscn9jleptxbnpgbuqa3xd0t64hixzcjcsdaqfu+0oeBSPo9pQ/lMT4sJlGBe6fW+Aci/VZYMM5+vvoashqvy/0G2J+nH2kD3B31Br/QKT/kJw2zj7SB7hHar2P9B+Nk8fZR/oAd0et8Q9E+o/GGePsL5E+nxHA2qj1PtJ/LM4YZz+sppooyfumfipip QFJ5PH2U+l778Uq5pEpbxK/GWvhVuxNnzCafn3rcaN8qQn3Iha7yP9h+PUcfaz0r+NSVSYX9NDOO4/VMY4NMPCBGBUQA3XD0T64CHJF42TQAQNZKFWTJEYOF2CP4PZID5QHT0G3W4O/U/B5FI/zUXU8AFKn1PtKHgRNPR24SLIVEGLIPZUBSMYR6ZK45HM7FKHGHN9YJTLEIELWD11BR/QKQPJNPR2SSLABMEPUFMU0LTXVXJXM5KPV+dpS3pHv5MaULE7wAnESt95E+DKTSF+UFRMV6RELEN03CJFVJTD+b3ilIP7NH8Y6XJ3gBqKfW+AcifXBE0u+NLtY5iUpFpD+/7lg1qZjp+YLPUI9YU840T1CKLRVI30Y8KUVXLONUANP6RCNRFGEYGRVVSAZPUYZ/EVNGIRV751F 8HO8ANRTA/wDkT44Dmmkv9pJVKzfYBp09+TEGZ54AQ1K037IJFHCW7HIZLKDUZEZ9A7KHWTQ632KDWMZ6YSGJLEBUGDQJX8G0R8YND4KSQMKFF689L4TQG9U2L7AL96NYVJI+J2LD6WFDWVGGLQJ1PTK/Np3eSv1hfPEsK6Rvrd2rZfWDrUxL5zaXlT4ArJla4x+I9K/PqONA3/0VgFK7MQzfTVF49yyn2Px06cdXAEk7SB/gHqn1PtK/NLOGJ9RUP7FO9Z6Y90PSX9T9I9I7RJUIFYCHP9B4B4B5ON9PVL3PD8DOOY3Q9DPAXPIKP0AI13KF61YAV4ZURFIOC9UGV8A5H+9YL0ROW0SLI3+6VL988H 36NRPHSzrabglar2p9k9k5pfnstpecmwsncptxbfse89f7o6m9uupbgo59yinlqy45hbrmkqlgmpg+lat917yla653pTGgztlgH6Aq1Jr/AORPjiy0l/nJCr+AD+dlv62hrdK4+PPbmrpcoA1Uet9pA8DJemvcRKVyfqdllkb8guylgyynh642xtutb6znlvtjraz+zayv4uua21xj8q6ynjrrrm0tfgxx/COzDYTWjtUpjukWjornzlGs1lb6YG8GNawO4PrXeR/owMC/9lU2i4kX04yCZQ2V/yDUPL8wvj8k8Wn/4Ly/97KDKzIsCt6HW+AcifXCk0vdD+3VNojLqfRrV06g+H+ON4Xk0TZ/mgsLEVIX0l94zBrg4td5H+jAQSb83uljpJCpD3em+Qadl9DIfcc9H+uFt4QrpE93Dbag1/oFIHxy+9ps7tmuermvao6tjcdllk1mjpauwcftizxdjnxhs4jbxer/owcEgj/VVPojLNZOW2lF4n5JiZfSXchcXSZ14UuBW1xj8Q6V+z1gc9jvypnrisjsdjvskHTLSF+1NopKetgDWTa33kf5VcRlvlwb2bz1exjZR1nqx9yPp95Q+lIf8sPwHMgHuglrjH4j0b0V676/TUMKXP09VENO0xJAAONOPDTZPT1PPQ88FOXI38SYMCHWBWTQ33KF5TYERFZ3DHIP9FYPQQBEKNGF9Y06JXLQTP/0f6AHdHrfEPRPq3Ih/pe8+oH5V++H4EEOZLP1M8KM/JE+wN3xUsnbt2+R/m24hPTD5o6ld7LN+NEKT7A3FHY8LN RK8CM9PPH8BZPD+7KTQADPHDLPD9RDDFGI/aY+I4D100t/oWOR/M0IH6R0NZKFX7UBJODRYKGVTKJHSTSTZ27XJVKGT0YKFSZRAVG/SB9OJ5W+/1LCHKVDBTJ8NOOYWE6NK/JgJlwDyB9OJ2S9NCXIYQUYR8VIA8HA6QP9WDSH9MPSX8NK6GOBYQ1LRU1YWKGMIHN+KCVKq/dojHVEgzbkgf1g7Sh9OZkf7tJ1EZv1XQaaVNbiD73PA4mRHV/AF7SGPIZ4FZAVGRTJO4DJ7TQDKDXNMPX/JSVSGZ5S6LCMIPW1KFM6OHPM+0ArJc00i8 Thanks for the tip. I did what you suggested. That did not change the original code you posted. The problem is still in the "For Each oLine In ThisDrawing.ModelSpace" line. same error
Are you drawing lines, polylines, or something else? The code will only work with lines, polylines etc will not be deleted. Try using this declaration for the oLine declaration:
Dim oLine As VariantBut that will pick all entities on the layer.
I tried the code out with just polylines and arcs (no lines) on the layer and got the same error message as you did. Check the properties of the entities on the layer to see that they are lines.
Ben Use SelectionSet and its powerful filtering and Erase methods
Sub DeleteElements() Dim delSset As AcadSelectionSet On Error Resume Next Set delSset = ThisDrawing.SelectionSets.Add("Deletion") On Error GoTo 0 If delSset Is Nothing Then Set delSset = ThisDrawing.SelectionSets.Item("Deletion") Dim gpCode(0 to 2) As Integer Dim dataValue(0 to 2) As Variant gpCode(0) = 0 : dataValue(0) = "LINE" ' filter on line elements only gpCode(1) = 8 : dataValue(1) = "myLayerName" ' filter on given layer gpCode(2) = 62 : dataValue(2) = 1 ' filter on color (1 is the red color dataValue) With delSset .Clear .Select acSelectionSetAll, , , gpCode, dataValue If .Count > 0 Then .Erase End WithEnd Sub Simple VBA can delete all objects
you need to alter the code to select only lines
code can be found here http://www.computeraidedautomation.com/forum-topic/delete-all-objects-autocad-vba
页:
[1]
2