katto01 发表于 2022-7-6 21:40:55

VBA-如何删除所有行

你好
 
 
问题1.我不知道该怎么做。我需要删除一个图层上的数百行。我需要在VBA中执行此操作。我不想使用选择。只需删除层上的所有行。
问题2。与问题1相同,但有一个关于颜色的条件(即,如果红色删除)。
 
 
谢谢

Tyke 发表于 2022-7-6 21:50:30

你好,Katto01,
 
下面是一些示例代码,可以帮助您继续。
 
删除“Layer1”层上的所有行:
删除“Layer1”层上的所有红线:
这应该能让你继续前进。如果你想用很多层重复这个过程,你可以在一个对话框中输入层和颜色,并使用输入的值进行删除。
 

katto01 发表于 2022-7-6 21:58:39

本,谢谢你的帮助
 
 
在这两种情况下,行“For Each oLine In ThisDrawing.ModelSpace”给出了错误“type mismatch”。我在AutoCAD 2011

BIGAL 发表于 2022-7-6 22:03:02

您可以尝试选择集方法
 
2

Tyke 发表于 2022-7-6 22:05:18

 
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

katto01 发表于 2022-7-6 22:12:46

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

Tyke 发表于 2022-7-6 22:18:24

 
Are you drawing lines, polylines, or something else? The code will only work with lines, polylines etc will not be deleted.

Tyke 发表于 2022-7-6 22:26:10

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

RICVBA 发表于 2022-7-6 22:33:36

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

Jings 发表于 2022-7-6 22:35:02

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
查看完整版本: VBA-如何删除所有行