├── (H)avertext(平均多单行文字的间距）.lsp ├── (PKPMSATWE中梁配筋百分率标记)BJ.lsp ├── (YJK中梁配筋百分率标记)BJ.lsp ├── AF-自动提取图中字体.LSP ├── CAD表格提取排序.LSP ├── CHTEXT.LSP ├── CRPIAO-圆半径转换.LSP ├── CSBJ-画板钢筋.LSP ├── CSDB-绘双线L.LSP ├── CSJOIN-连接线.LSP ├── CSLF-关闭图层.LSP ├── CSLM-设当前层.LSP ├── CSPEDIT-改变线宽.LSP ├── CTX与STX文本刷及文本内容交换.lsp ├── ET.LSP ├── FW-标注方位角.LSP ├── HH-工具集(完成).lsp ├── README.md ├── SAP2000转dwg(sap2dwg).lsp ├── TXTFIX数字按50 100取整.LSP ├── UCAD-高程传递高程.LSP ├── WD--快速绘制焊缝.lsp ├── XX逐点标注.LSP ├── Xref_V2.3.lsp ├── YL约束边缘构件L型剪力墙(yl).LSP ├── YY-BREAK.lsp ├── [qjchen] 单向直线阵列one way copy 1.0.lsp ├── [qjchen] 环形阵列one way polar 2.0 vla-rotate.lsp ├── bb-图纸分幅.lsp ├── bzpyj-坐标标注示例.lsp ├── b板筋工具V1.0.lsp ├── checkbeam.lsp ├── chgtext-批量替换字符.lsp ├── chtext.lsp ├── ct-写带圆圈数字.lsp ├── cv.lsp ├── dycy-标注序号.lsp ├── fillread-读文件到列表.LSP ├── ft-自动修改字体.LSP ├── hzbrea-文字击碎.lsp ├── peditn-修改线弧圆宽度.lsp ├── satwe多层配筋取大归并梁(lgb).LSP ├── testa-亮显指定颜色的实体.LSP ├── tmp-转换坐标系.lsp ├── vlx ├── AB改块基点.VLX ├── BG标高大师.VLX ├── CW改宽度.VLX ├── FS_SS.VLX ├── FWXS(范围选数).VLX ├── GG GBJ]平法之拉移随心20130723版.VLX ├── YX(云线).vlx ├── [BBC]梁柱交线处理.VLX ├── [GG]平法之拉移随心儿童节.VLX ├── [ljbh]梁加编号V1.1.VLX ├── cb快速建块.VLX ├── ft图纸归档-批打.VLX ├── jggj板钢筋剪断(结构工具).VLX ├── zc.VLX ├── 华森结构1.06.VLX ├── 墙柱工具2014-0802.VLX ├── 层间归并.VLX ├── 平法之拉移随心.VLX ├── 批量插件快捷键是BPLOT.VLX ├── 柱墙填充-TC.VLX ├── 结果导入.VLX ├── 编译文件 ├── 计算书归并一(lgb zgb qgb).VLX ├── 贱人5.8.VLX └── （批量打印）BATCHPLOT.VLX ├── xscale-XY方向不同比例缩放.lsp ├── zdt-坐标展点.lsp ├── 《标注工具》之《外包尺寸（WBChC）》V20110620.lsp ├── 三种大箭头jt.lsp ├── 主梁校对(checkbeam).lsp ├── 交点打断（br） ├── 刷文字角度（TT）.lsp ├── 剪力墙下轴力求和(NHE).LSP ├── 双向偏移（db） ├── 可以生成XREF里面的选定的实体的拷贝(copyn).lsp ├── 图层冻结管理.lsp ├── 块属性编辑程序 _chattdef.lsp ├── 块改(gkm).lsp ├── 增强复制.lsp ├── 多义线添加顶点.LSP ├── 多边形标注DBXBZ.lsp ├── 多选式图层合并.lsp ├── 好用-计算并写入线长.lsp ├── 实体所见即所得（zz） ├── 对当前图形里的常规词典进行列表(dicts).LSP ├── 对象对齐yxpq.lsp ├── 小菜选择易(SS).lsp ├── 小菜选择易.lsp ├── 层工具.lsp ├── 批量实体填充（tcs）.lsp ├── 批量注记直线的长度.lsp ├── 改块颜色（se） ├── 改斜归正＿专门对付歪门斜道（ GXGZH）.LSP ├── 文字与表格对齐TableMulAlign v1.1.lsp ├── 文字刷（aa） ├── 文字打断填充ShowHatchTextV1-0.lsp ├── 文字编号修改.lsp ├── 文本动态对齐于曲线.lsp ├── 柱填实Column.LSP ├── 模糊距离合并文字.LSP ├── 相同刷.lsp ├── 相对路径与完整路径之间相互转化 RepathXrefs 1.0a.lsp ├── 碰头线.lsp ├── 编号.lsp ├── 让CAD也能实现所见即所得＿源码（ YJWSh）.lsp ├── 超级剪切（J） ├── 超酷剪切.LSP ├── 连接线段.lsp ├── 选择易（ss） └── 镜像mirror(mmi).lsp /(H)avertext(平均多单行文字的间距）.lsp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/(H)avertext(平均多单行文字的间距）.lsp -------------------------------------------------------------------------------- /(PKPMSATWE中梁配筋百分率标记)BJ.lsp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/(PKPMSATWE中梁配筋百分率标记)BJ.lsp -------------------------------------------------------------------------------- /(YJK中梁配筋百分率标记)BJ.lsp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/(YJK中梁配筋百分率标记)BJ.lsp -------------------------------------------------------------------------------- /AF-自动提取图中字体.LSP: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/AF-自动提取图中字体.LSP -------------------------------------------------------------------------------- /CAD表格提取排序.LSP: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/CAD表格提取排序.LSP -------------------------------------------------------------------------------- /CHTEXT.LSP: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/CHTEXT.LSP -------------------------------------------------------------------------------- /CRPIAO-圆半径转换.LSP: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/CRPIAO-圆半径转换.LSP -------------------------------------------------------------------------------- /CSBJ-画板钢筋.LSP: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/CSBJ-画板钢筋.LSP -------------------------------------------------------------------------------- /CSDB-绘双线L.LSP: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/CSDB-绘双线L.LSP -------------------------------------------------------------------------------- /CSJOIN-连接线.LSP: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/CSJOIN-连接线.LSP -------------------------------------------------------------------------------- /CSLF-关闭图层.LSP: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/CSLF-关闭图层.LSP -------------------------------------------------------------------------------- /CSLM-设当前层.LSP: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/CSLM-设当前层.LSP -------------------------------------------------------------------------------- /CSPEDIT-改变线宽.LSP: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/CSPEDIT-改变线宽.LSP -------------------------------------------------------------------------------- /CTX与STX文本刷及文本内容交换.lsp: -------------------------------------------------------------------------------- 1 | ;;------------------=={ Copy or Swap Text }==-----------------;; 2 | ;; ;; 3 | ;; Allows a user to select a source text object ;; 4 | ;; (Text, MText, Attribute, Multileader), and proceed to ;; 5 | ;; copy (or swap) its text contents to (with) a multitude of ;; 6 | ;; destination objects. ;; 7 | ;; ;; 8 | ;; The destination objects may be selected individually, or, ;; 9 | ;; when copying text, upon opting for the 'Multiple' ;; 10 | ;; selection, the user may copy to a SelectionSet of ;; 11 | ;; objects. ;; 12 | ;; ;; 13 | ;; Upon choosing 'Settings' the user may alter whether ;; 14 | ;; MText formatting is retained when copying (or swapping) ;; 15 | ;; text to (with) objects which permit the use of such ;; 16 | ;; formatting. ;; 17 | ;;------------------------------------------------------------;; 18 | ;; Author: Lee Mac, Copyright ?2010 - www.lee-mac.com ;; 19 | ;;------------------------------------------------------------;; 20 | ;; Version 1.1 - 17-12-2010 ;; 21 | ;; ;; 22 | ;; Added ability to retain/remove MText formatting. Setting ;; 23 | ;; is stored as a global variable (*retain*) ;; 24 | ;;------------------------------------------------------------;; 25 | ;; Version 1.2 - 20-12-2010 ;; 26 | ;; ;; 27 | ;; Entire program rewritten to include SwapText capability. ;; 28 | ;;------------------------------------------------------------;; 29 | ;; Version 1.3 - 05-01-2011 ;; 30 | ;; ;; 31 | ;; Fixed minor formatting bugs. ;; 32 | ;;------------------------------------------------------------;; 33 | 34 | (defun c:CTx nil (CopyorSwapText nil)) 35 | 36 | (defun c:WZHH nil (CopyorSwapText t)) 37 | 38 | ;;------------------------------------------------------------;; 39 | 40 | (defun CopyorSwapText 41 | 42 | ( swap 43 | 44 | / 45 | 46 | *error* 47 | _StartUndo 48 | _EndUndo 49 | _UnFormat 50 | _AllowsFormatting 51 | 52 | doc 53 | entity 54 | ms1 55 | ms2 56 | mstr 57 | o1 58 | o2 59 | ostr 60 | regexp 61 | ss 62 | string 63 | ts1 64 | ts2 65 | tstr 66 | ) 67 | 68 | (vl-load-com) 69 | 70 | (setq *retain* (cond ( *retain* ) ( "Yes" ))) 71 | 72 | ;;------------------------------------------------------------;; 73 | ;; Local Functions ;; 74 | ;;------------------------------------------------------------;; 75 | 76 | (defun *error* ( msg ) 77 | (LM:ReleaseObject RegExp) (if doc (_EndUndo doc)) 78 | (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") 79 | (princ (strcat "\n** Error: " msg " **"))) 80 | (princ) 81 | ) 82 | 83 | ;;------------------------------------------------------------;; 84 | 85 | (defun _StartUndo ( doc ) (_EndUndo doc) 86 | (vla-StartUndoMark doc) 87 | ) 88 | 89 | ;;------------------------------------------------------------;; 90 | 91 | (defun _EndUndo ( doc ) 92 | (if (= 8 (logand 8 (getvar 'UNDOCTL))) 93 | (vla-EndUndoMark doc) 94 | ) 95 | ) 96 | 97 | ;;------------------------------------------------------------;; 98 | 99 | (defun _UnFormat ( regex entity textstring mtextstring / *error* _Replace ) 100 | 101 | (defun _Replace ( new old string ) 102 | (vlax-put-property regex 'pattern old) (vlax-invoke regex 'replace string new) 103 | ) 104 | 105 | ( 106 | (lambda ( string ) 107 | (if (_AllowsFormatting entity) 108 | (mapcar 109 | (function 110 | (lambda ( x ) (setq string (_Replace (car x) (cdr x) string))) 111 | ) 112 | '( 113 | ("" . "\\\\\\\\") 114 | (" " . "\\\\P|\\n|\\t") 115 | ("$1" . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]") 116 | ("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);") 117 | ("$1$2" . "\\\\(\\\\S)|[\\\\](})|}") 118 | ("$1" . "[\\\\]({)|{") 119 | ) 120 | ) 121 | (setq string (_Replace "" "%%[OoUu]" (_Replace "" "\\\\" string))) 122 | ) 123 | (set mtextstring (_Replace "\\\\" "" (_Replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" string))) 124 | (set textstring (_Replace "\\" "" string)) 125 | ) 126 | (LM:GetTextString entity) 127 | ) 128 | nil 129 | ) 130 | 131 | ;;------------------------------------------------------------;; 132 | 133 | (defun _Selectif ( pred func str keyW / e result ) 134 | (while 135 | (progn (setvar 'ERRNO 0) (if keyW (initget keyW)) (setq e (func str)) 136 | (cond 137 | ( (= 7 (getvar 'ERRNO)) 138 | 139 | (princ "\n** Missed, Try again **") 140 | ) 141 | ( (and keyW (eq 'STR (type e))) 142 | 143 | (not (setq result e)) 144 | ) 145 | ( (vl-consp e) 146 | 147 | (if (and pred (not (pred (car e)))) 148 | (princ "\n** Invalid Object Selected **") 149 | (not (setq result (car e))) 150 | ) 151 | ) 152 | ) 153 | ) 154 | ) 155 | result 156 | ) 157 | 158 | ;;------------------------------------------------------------;; 159 | 160 | (defun _AllowsFormatting ( entity / object ) 161 | 162 | (or (wcmatch (cdr (assoc 0 (entget entity))) "MTEXT,MULTILEADER") 163 | (and 164 | (eq "ATTRIB" (cdr (assoc 0 (entget entity)))) 165 | (vlax-property-available-p (setq object (vlax-ename->vla-object entity)) 'MTextAttribute) 166 | (eq :vlax-true (vla-get-MTextAttribute object)) 167 | ) 168 | ) 169 | ) 170 | 171 | ;;------------------------------------------------------------;; 172 | ;; Main Function ;; 173 | ;;------------------------------------------------------------;; 174 | 175 | (setq RegExp (vlax-get-or-create-object "VBScript.RegExp")) 176 | 177 | (mapcar 178 | (function 179 | (lambda ( x ) (vlax-put-property RegExp (car x) (cdr x))) 180 | ) 181 | (list (cons 'global actrue) (cons 'ignorecase acfalse) (cons 'multiline actrue)) 182 | ) 183 | 184 | (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))) 185 | 186 | (cond 187 | ( 188 | swap 189 | (while 190 | (and 191 | (progn 192 | (while 193 | (and (princ (strcat "\n--> Formatting Retained: " *retain*)) 194 | (setq o1 195 | (_Selectif 196 | (lambda ( entity ) 197 | (wcmatch (cdr (assoc 0 (entget entity))) "*TEXT,ATTRIB,MULTILEADER") 198 | ) 199 | nentsel "\nSelect Text to Swap [Settings/Exit] : " "Settings Exit" 200 | ) 201 | ) 202 | (eq 'STR (type o1)) (not (eq "Exit" o1)) 203 | ) 204 | (initget "Yes No") 205 | (setq *retain* 206 | (cond 207 | ( 208 | (getkword 209 | (strcat "\nRetain MText Formatting [Yes/No] <" *retain* "> : ") 210 | ) 211 | ) 212 | ( *retain* ) 213 | ) 214 | ) 215 | ) 216 | o1 217 | ) 218 | (setq o2 219 | (_Selectif 220 | (lambda ( entity ) 221 | (wcmatch (cdr (assoc 0 (entget entity))) "*TEXT,ATTRIB,MULTILEADER") 222 | ) 223 | nentsel "\nAnd Text to Swap it With [Exit] : " "Exit" 224 | ) 225 | ) 226 | (not (eq "Exit" o2)) 227 | ) 228 | 229 | (_StartUndo doc) 230 | 231 | (setq s1 (LM:GetTextString o1) 232 | s2 (LM:GetTextString o2) 233 | ) 234 | 235 | (_Unformat RegExp o1 'ts1 'ms1) 236 | (_Unformat RegExp o2 'ts2 'ms2) 237 | 238 | (apply 239 | (function 240 | (lambda ( retain MText1 MText2 ) 241 | 242 | (setq o1 (vlax-ename->vla-object o1) 243 | o2 (vlax-ename->vla-object o2) 244 | ) 245 | (cond 246 | ( 247 | (and MText1 MText2) 248 | 249 | (vla-Put-TextString o1 (if retain s2 ms2)) 250 | (vla-Put-TextString o2 (if retain s1 ms1)) 251 | ) 252 | ( 253 | MText1 254 | 255 | (vla-Put-TextString o1 ms2) 256 | (vla-Put-TextString o2 ts1) 257 | ) 258 | ( 259 | MText2 260 | 261 | (vla-Put-TextString o1 ts2) 262 | (vla-Put-TextString o2 ms1) 263 | ) 264 | ( 265 | t 266 | 267 | (vla-Put-TextString o1 (if retain s2 ts2)) 268 | (vla-Put-TextString o2 (if retain s1 ts1)) 269 | ) 270 | ) 271 | ) 272 | ) 273 | (cons (eq "Yes" *retain*) (mapcar '_AllowsFormatting (list o1 o2))) 274 | ) 275 | 276 | (_EndUndo doc) 277 | ) 278 | ) 279 | (t 280 | (if 281 | (progn 282 | (while 283 | (and (princ (strcat "\n--> Formatting Retained: " *retain*)) 284 | (setq o1 285 | (_Selectif 286 | (lambda ( entity ) 287 | (wcmatch (cdr (assoc 0 (entget entity))) "*TEXT,ATTRIB,MULTILEADER") 288 | ) 289 | nentsel "\nSelect Source Object [Settings/Exit] : " "Settings Exit" 290 | ) 291 | ) 292 | (eq 'STR (type o1)) (not (eq "Exit" o1)) 293 | ) 294 | (initget "Yes No") 295 | (setq *retain* 296 | (cond 297 | ( 298 | (getkword 299 | (strcat "\nRetain MText Formatting [Yes/No] <" *retain* "> : ") 300 | ) 301 | ) 302 | ( *retain* ) 303 | ) 304 | ) 305 | ) 306 | o1 307 | ) 308 | (progn 309 | (setq ostr (LM:GetTextString o1)) 310 | 311 | (_Unformat RegExp o1 'tstr 'mstr) 312 | 313 | (if (eq "Yes" *retain*) 314 | (set (if (_AllowsFormatting o1) 'mstr 'tstr) ostr) 315 | ) 316 | 317 | (_StartUndo doc) (terpri) 318 | 319 | (while 320 | (and 321 | (setq o2 322 | (_Selectif 323 | (lambda ( entity ) 324 | (wcmatch (cdr (assoc 0 (entget entity))) "*TEXT,ATTRIB,MULTILEADER") 325 | ) 326 | nentsel "\rSelect Destination Object [Multiple/Exit] : " "Multiple Exit" 327 | ) 328 | ) 329 | (not (eq "Exit" o2)) 330 | ) 331 | (cond 332 | ( 333 | (eq "Multiple" o2) 334 | 335 | (if 336 | (setq ss 337 | (ssget "_:L" 338 | '( 339 | (-4 . "") 345 | (-4 . "OR>") 346 | ) 347 | ) 348 | ) 349 | ( 350 | (lambda ( i / _type e ) 351 | (while (setq e (ssname ss (setq i (1+ i)))) 352 | (cond 353 | ( 354 | (eq "INSERT" (setq _type (cdr (assoc 0 (entget e))))) 355 | 356 | (mapcar 357 | (function 358 | (lambda ( attrib ) 359 | (vla-put-TextString attrib 360 | (if 361 | (and 362 | (vlax-property-available-p attrib 'MTextAttribute) 363 | (eq :vlax-true (vla-get-MTextAttribute attrib)) 364 | ) 365 | mstr tstr 366 | ) 367 | ) 368 | ) 369 | ) 370 | (vlax-invoke (vlax-ename->vla-object e) 'GetAttributes) 371 | ) 372 | ) 373 | (t 374 | (vla-put-TextString (vlax-ename->vla-object e) (if (_AllowsFormatting e) mstr tstr)) 375 | ) 376 | ) 377 | ) 378 | ) 379 | -1 380 | ) 381 | ) 382 | t 383 | ) 384 | ( (vla-put-TextString (vlax-ename->vla-object o2) (if (_AllowsFormatting o2) mstr tstr)) ) 385 | ) 386 | ) 387 | 388 | (_EndUndo doc) 389 | ) 390 | ) 391 | ) 392 | ) 393 | 394 | (LM:ReleaseObject RegExp) 395 | (princ) 396 | ) 397 | 398 | ;;--------------------=={ Get TextString }==------------------;; 399 | ;; ;; 400 | ;; Returns the TexString associated with an object, ;; 401 | ;; retaining all special symbols. ;; 402 | ;;------------------------------------------------------------;; 403 | ;; Author: Lee Mac, Copyright ?2010 - www.lee-mac.com ;; 404 | ;;------------------------------------------------------------;; 405 | ;; Arguments: ;; 406 | ;; object - VLA-Object/ename for which to return TextString ;; 407 | ;;------------------------------------------------------------;; 408 | ;; Returns: TextString associated with object, else nil ;; 409 | ;;------------------------------------------------------------;; 410 | 411 | (defun LM:GetTextString ( object ) 412 | ;; ?Lee Mac 2010 413 | ( 414 | (lambda ( entity / _type elist ) 415 | (cond 416 | ( 417 | (wcmatch 418 | (setq _type 419 | (cdr 420 | (assoc 0 421 | (setq elist 422 | (entget entity) 423 | ) 424 | ) 425 | ) 426 | ) 427 | "TEXT,*DIMENSION" 428 | ) 429 | (cdr (assoc 1 elist)) 430 | ) 431 | ( 432 | (eq "MULTILEADER" _type) 433 | 434 | (cdr (assoc 304 elist)) 435 | ) 436 | ( 437 | (wcmatch _type "ATTRIB,MTEXT") 438 | 439 | ( 440 | (lambda ( string ) 441 | (mapcar 442 | (function 443 | (lambda ( pair ) 444 | (if (member (car pair) '(1 3)) 445 | (setq string (strcat string (cdr pair))) 446 | ) 447 | ) 448 | ) 449 | elist 450 | ) 451 | string 452 | ) 453 | "" 454 | ) 455 | ) 456 | ) 457 | ) 458 | (if (eq 'VLA-OBJECT (type object)) 459 | (vlax-vla-object->ename object) 460 | object 461 | ) 462 | ) 463 | ) 464 | 465 | ;;------------------=={ Release Object }==--------------------;; 466 | ;; ;; 467 | ;; Releases a VLA Object from memory via plentiful error ;; 468 | ;; trapping ;; 469 | ;;------------------------------------------------------------;; 470 | ;; Author: Lee Mac, Copyright ?2010 - www.lee-mac.com ;; 471 | ;;------------------------------------------------------------;; 472 | ;; Arguments: ;; 473 | ;; obj - VLA Object to be released from memory ;; 474 | ;;------------------------------------------------------------;; 475 | ;; Returns: T if Object Released, else nil ;; 476 | ;;------------------------------------------------------------;; 477 | 478 | (defun LM:ReleaseObject ( obj ) (vl-load-com) 479 | ;; ?Lee Mac 2010 480 | (and obj (eq 'VLA-OBJECT (type obj)) (not (vlax-object-released-p obj)) 481 | (not 482 | (vl-catch-all-error-p 483 | (vl-catch-all-apply 484 | (function vlax-release-object) (list obj) 485 | ) 486 | ) 487 | ) 488 | ) 489 | ) 490 | 491 | 492 | (princ) 493 | (princ "\n:: CopyText.lsp | Version 1.3 | ?Lee Mac 2011 www.lee-mac.com ::") 494 | (princ "\n:: Type \"CTx\" to Copy or \"WZHH\" to Swap ::") 495 | (princ) -------------------------------------------------------------------------------- /ET.LSP: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/ET.LSP -------------------------------------------------------------------------------- /FW-标注方位角.LSP: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/FW-标注方位角.LSP -------------------------------------------------------------------------------- /HH-工具集(完成).lsp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/HH-工具集(完成).lsp -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # AutoCad-App 2 | AutoCad插件集合（AutoCad App） 3 | 4 | 收集网络中AutoCad插件源代码,如果你有好的lsp也想分享，可以联系我！ 5 | 如果这里面有你的原创，又不想分享，可以联系我删除！ 6 | 7 | 每个文件的大概介绍 8 | 9 | | 序号 | 文件 | 命令 | 10 | | :- | :- | :- | 11 | | 1 | (H)avertext(平均多单行文字的间距）.lsp | H | 12 | | 2 | (PKPMSATWE中梁配筋百分率标记)BJ.lsp | | 13 | | 3 | (YJK中梁配筋百分率标记)BJ.lsp | BJ | 14 | | 4 | AF-自动提取图中字体.LSP | AF | 15 | | 5 | CAD表格提取排序.LSP | | 16 | | 6 | CHTEXT.LSP | | 17 | | 7 | CRPIAO-圆半径转换.LSP | CRPIAO | 18 | | 8 | CSBJ-画板钢筋.LSP | CSBJ | 19 | | 9 | CSDB-绘双线L.LSP | CSDB | 20 | | 10 | CSJOIN-连接线.LSP | CSJOIN | 21 | | 11 | CSLF-关闭图层.LSP | CSLF | 22 | | 12 | CSLM-设当前层.LSP | CSLM | 23 | | 13 | CSPEDIT-改变线宽.LSP | CSPEDIT | 24 | | 14 | CTX与STX文本刷及文本内容交换.lsp | CTX,STX | 25 | | 15 | ET.LSP | | 26 | | 16 | FW-标注方位角.LSP | FW | 27 | | 17 | HH-工具集(完成).lsp | HH | 28 | | 18 | SAP2000转dwg(sap2dwg).lsp | | 29 | | 19 | TXTFIX数字按50 100取整.LSP | | 30 | | 20 | UCAD-高程传递高程.LSP | | 31 | | 21 | WD--快速绘制焊缝.lsp | WD | 32 | | 22 | XX逐点标注.LSP | | 33 | | 23 | Xref_V2.3.lsp | | 34 | | 24 | YL约束边缘构件L型剪力墙(yl).LSP | yl | 35 | | 25 | YY-BREAK.lsp | | 36 | | 26 | [qjchen] 单向直线阵列one way copy 1.0.lsp | qjchen | 37 | | 27 | [qjchen] 环形阵列one way polar 2.0 vla-rotate.lsp | qjchen | 38 | | 28 | bb-图纸分幅.lsp | bb | 39 | | 29 | bzpyj-坐标标注示例.lsp | bzpyj | 40 | | 30 | checkbeam.lsp | | 41 | | 31 | chgtext-批量替换字符.lsp | | 42 | | 32 | chtext.lsp | | 43 | | 33 | ct-写带圆圈数字.lsp | | 44 | | 34 | cv.lsp | | 45 | | 35 | dycy-标注序号.lsp | | 46 | | 36 | fillread-读文件到列表.LSP | | 47 | | 37 | ft-自动修改字体.LSP | ft | 48 | | 38 | hzbrea-文字击碎.lsp | | 49 | | 39 | peditn-修改线弧圆宽度.lsp | | 50 | | 40 | satwe多层配筋取大归并梁(lgb).LSP | lgb | 51 | | 41 | testa-亮显指定颜色的实体.LSP | | 52 | | 42 | tmp-转换坐标系.lsp | | 53 | | 43 | xscale-XY方向不同比例缩放.lsp | | 54 | | 44 | zdt-坐标展点.lsp | zbt | 55 | | 45 | 《标注工具》之《外包尺寸（WBChC）》V20110620.lsp | WBChC | 56 | | 46 | 三种大箭头jt.lsp | jt | 57 | | 47 | 主梁校对(checkbeam).lsp | checkbeam | 58 | | 48 | 交点打断（br） | br | 59 | | 49 | 刷文字角度（TT）.lsp | TT | 60 | | 50 | 剪力墙下轴力求和(NHE).LSP | NHE | 61 | | 51 | 双向偏移（db） | db | 62 | | 52 | 可以生成XREF里面的选定的实体的拷贝(copyn).lsp | copyn | 63 | | 53 | 图层冻结管理.lsp | | 64 | | 54 | 块属性编辑程序 _chattdef.lsp | | 65 | | 55 | 块改(gkm).lsp | gkm | 66 | | 56 | 增强复制.lsp | | 67 | | 57 | 多义线添加顶点.LSP | | 68 | | 58 | 多边形标注DBXBZ.lsp | DBXBZ | 69 | | 59 | 多选式图层合并.lsp | | 70 | | 60 | 好用-计算并写入线长.lsp | | 71 | | 61 | 实体所见即所得（zz） | zz | 72 | | 62 | 对当前图形里的常规词典进行列表(dicts).LSP | | 73 | | 63 | 对象对齐yxpq.lsp | | 74 | | 64 | 小菜选择易(SS).lsp | SS | 75 | | 65 | 小菜选择易.lsp | | 76 | | 66 | 层工具.lsp | | 77 | | 67 | 批量实体填充（tcs）.lsp | tcs | 78 | | 68 | 批量注记直线的长度.lsp | | 79 | | 69 | 改块颜色（se） | se | 80 | | 70 | 改斜归正＿专门对付歪门斜道（ GXGZH）.LSP | GXGZH | 81 | | 71 | 文字与表格对齐TableMulAlign v1.1.lsp | | 82 | | 72 | 文字刷（aa） | aa | 83 | | 73 | 文字打断填充ShowHatchTextV1-0.lsp | | 84 | | 74 | 文字编号修改.lsp | | 85 | | 75 | 文本动态对齐于曲线.lsp | | 86 | | 76 | 柱填实Column.LSP | | 87 | | 77 | 模糊距离合并文字.LSP | | 88 | | 78 | 相同刷.lsp | | 89 | | 79 | 相对路径与完整路径之间相互转化 RepathXrefs 1.0a.lsp | | 90 | | 80 | 碰头线.lsp | | 91 | | 81 | 编号.lsp | | 92 | | 82 | 让CAD也能实现所见即所得＿源码（ YJWSh）.lsp | YJWSh | 93 | | 83 | 超级剪切（J） | J | 94 | | 84 | 超酷剪切.LSP | | 95 | | 85 | 连接线段.lsp | | 96 | | 86 | 选择易（ss） | ss | 97 | | 87 | 镜像mirror(mmi).lsp | mmi | 98 | -------------------------------------------------------------------------------- /SAP2000转dwg(sap2dwg).lsp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/SAP2000转dwg(sap2dwg).lsp -------------------------------------------------------------------------------- /TXTFIX数字按50 100取整.LSP: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/TXTFIX数字按50 100取整.LSP -------------------------------------------------------------------------------- /UCAD-高程传递高程.LSP: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/UCAD-高程传递高程.LSP -------------------------------------------------------------------------------- /WD--快速绘制焊缝.lsp: -------------------------------------------------------------------------------- 1 | 2 | (DEFUN C:WD () 3 | (setq cl (getvar "clayer")) 4 | (Setvar "cmdecho" 0) 5 | (COMMAND "LAYER" "M" "WELD" "C" "M" "" "LT" "CONTINUOUS" "" "") 6 | (SETQ S (GETVAR "SNAPANG")) 7 | (SETQ P1 (GETPOINT "\nSTART POINT: ")) 8 | (SETQ P2 (GETPOINT P1 "\nEND POINT: ")) 9 | (SETQ Z (GETREAL "\nWELD SIZE: ")) 10 | (SETQ P3 (POLAR P1 (ANGLE P1 P2) (* 2 Z))) 11 | (setq osm (getvar "osmode")) 12 | (setvar "osmode" 0) 13 | (COMMAND "ARC" P1 "E" P3 "A" 180) 14 | (SETQ P4 (POLAR P3 (- (ANGLE P1 P2) (* 120 (/ PI 180))) Z)) 15 | (SETQ N (- (/ (DISTANCE P1 P2) Z) 2)) 16 | (COMMAND "ARC" P4 "C" P3 "A" 120) 17 | (SETQ X 1) 18 | (WHILE (<= X N)(SETQ X (+ X 1))) 19 | (SETVAR "SNAPANG" (ANGLE P1 P2)) 20 | (COMMAND "ARRAY" "LAST" "" "R" "" (- X 1) Z) 21 | (SETVAR "SNAPANG" 0) 22 | (PRINC) 23 | (command ".layer" "set" cl "") 24 | (setvar "osmode" 171) 25 | ) 26 | -------------------------------------------------------------------------------- /XX逐点标注.LSP: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/XX逐点标注.LSP -------------------------------------------------------------------------------- /Xref_V2.3.lsp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/Xref_V2.3.lsp -------------------------------------------------------------------------------- /YL约束边缘构件L型剪力墙(yl).LSP: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/YL约束边缘构件L型剪力墙(yl).LSP -------------------------------------------------------------------------------- /YY-BREAK.lsp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/YY-BREAK.lsp -------------------------------------------------------------------------------- /[qjchen] 单向直线阵列one way copy 1.0.lsp: -------------------------------------------------------------------------------- 1 | ;;; ======================================================================== 2 | ;;; the following code are writen by qjchen ; 3 | ;;; Purpose: To dynamic copy Object in one way ; 4 | ;;; Thanks to: lushui2 (The original idea Author) ; 5 | ;;; Andera (He post a very cool Dynamic Array rountine) ; 6 | ;;; at http://www.theswamp.org/index.php?topic=26633.5 ; 7 | ;;; Version v 1.0 2011.03.15 ; 8 | ;;; Http://chenqj.blogspot.com ; 9 | ;;; ======================================================================== 10 | 11 | ;;; =======================================================================; 12 | ;;; The main function ; 13 | ;;; =======================================================================; 14 | (vl-load-com) 15 | (defun c:CC( / dir gr nx p0 px pxv ss ss1 vecx) 16 | (setq ss (std-sslist (ssget)) 17 | p0 (getpoint "\nP0:") px (getpoint p0 "\nPx:") 18 | vecx (mapcar '- px p0) 19 | ) 20 | (prompt "\nThe end point:") 21 | (while (= (car (setq gr (grread nil 5 0))) 5) 22 | (if ss1 (q:ss:del ss1)) 23 | (redraw) 24 | (setq pxv (mapcar '- (inters (cadr gr) (polar (cadr gr) (+ (/ pi 2.0) (angle px p0)) 1.0) p0 px nil) p0)) 25 | (if (< (setq nx (fix (/ (caddr (trans pxv 0 vecx)) (caddr (trans vecx 0 vecx))))) 0) 26 | (setq dir -1 nx (- nx)) (setq dir 1)) 27 | (setq ss1 (q:ss:dyngen ss nx vecx dir)) 28 | (grdraw p0 (mapcar '+ p0 pxv) 3 1) 29 | ) 30 | (princ) 31 | ) 32 | 33 | ;;; =======================================================================; 34 | ;;; by qjchen, copy ss according to the direction and vector ; 35 | ;;; =======================================================================; 36 | (defun q:ss:dyngen (sslst n v dir / i matlist obj1 ss transmat xobj) 37 | (setq ss (ssadd)) 38 | (foreach x sslst 39 | (setq xobj (vlax-ename->vla-object x) i 1) 40 | (repeat n 41 | (setq obj1 (vla-copy xobj) 42 | matList (list (list 1 0 0 (* i (car v) dir)) (list 0 1 0 (* i (cadr v) dir)) '(0 0 1 0) '(0 0 0 1)) 43 | transmat (vlax-tmatrix matlist)) 44 | (vla-transformby obj1 transMat) 45 | (ssadd (vlax-vla-object->ename obj1) ss) 46 | (setq i (1+ i)) 47 | ) 48 | ) 49 | ss 50 | ) 51 | 52 | ;;; =======================================================================; 53 | ;;; by qjchen, entdel ss ; 54 | ;;; =======================================================================; 55 | ;; (setq a (ssget)) ; 56 | ;; (q:ss:del a) ; 57 | ;;; =======================================================================; 58 | (defun q:ss:del (ss / i) 59 | (setq i 0) 60 | (repeat (sslength ss) 61 | (entdel (ssname ss i)) 62 | (setq i (1+ i)) 63 | ) 64 | ) 65 | ;;; =======================================================================; 66 | ;;; by qjchen, 2 ss add ; 67 | ;;; =======================================================================; 68 | (defun q:ss:add (ss1 ss2 / i) 69 | (setq i -1) 70 | (repeat (sslength ss2) 71 | (setq i (1+ i)) 72 | (setq ss1 (ssadd (ssname ss2 i) ss1)) 73 | ) 74 | ss1 75 | ) 76 | ;;; =======================================================================; 77 | ;;; selection to list, by Reini Urban ; 78 | ;;; =======================================================================; 79 | (defun std-sslist (ss / n lst) 80 | (if (eq 'pickset (type ss)) 81 | (repeat (setq n (fix (sslength ss))) ; fixed 82 | (setq lst (cons (ssname ss (setq n (1- n))) lst)))) 83 | ) 84 | 85 | 86 | (princ "by qjchen@gmail.com, To dynamic Array object, the command is Test") 87 | 88 | 89 | 90 | -------------------------------------------------------------------------------- /[qjchen] 环形阵列one way polar 2.0 vla-rotate.lsp: -------------------------------------------------------------------------------- 1 | ;;; ======================================================================== 2 | ;;; the following code are writen by CHEN QING JUN ; 3 | ;;; Civil engineering Department, South China University of Technology ; 4 | ;;; Purpose: To dynamic copy Object in polar ; 5 | ;;; Version v 1.0 2011.03.16 ; 6 | ;;; Http://chenqj.blogspot.com ; 7 | ;;; ======================================================================== 8 | 9 | ;;; =======================================================================; 10 | ;;; The main function ; 11 | ;;; =======================================================================; 12 | (vl-load-com) 13 | (defun c:HXFZ( / ang angnow gr oang p0 px px1 ss ss1) 14 | (setq ss (std-sslist (ssget)) 15 | p0 (getpoint "\nP0,the center :") px (getpoint p0 "\nThe angle start Point:") 16 | px1 (getpoint p0 "\nThe angle end Point:") 17 | ang (- (angle p0 px1)(setq oang (angle p0 px))) 18 | ) 19 | (prompt "\nThe rotation point:") 20 | (while (= (car (setq gr (grread nil 5 0))) 5) 21 | (if ss1 (mapcar 'vla-delete ss1)) 22 | (redraw) 23 | (setq angnow (- (angle p0 (cadr gr)) oang)) 24 | (if (and (< ang 0)(> angnow 0)) (setq angnow (- angnow (* 2 pi)))) 25 | (if (and (> ang 0)(< angnow 0)) (setq angnow (+ (* 2 pi) angnow))) 26 | (setq ss1 (q:ss:dyngenpolar ss (fix (/ angnow ang)) p0 ang)) 27 | (q:grdraw:arc p0 (/ (getvar "viewsize") 4.0) oang angnow) 28 | ) 29 | (princ) 30 | ) 31 | 32 | ;;; =======================================================================; 33 | ;;; by qjchen, grdraw circle arc ; 34 | ;;; =======================================================================; 35 | (defun q:grdraw:arc(cen r ang angadd / angdiv n) 36 | (grdraw cen (polar cen ang r) 3 1) 37 | (grdraw cen (polar cen (+ ang angadd) r) 3 1) 38 | (setq n 100 angdiv (/ angadd n)) 39 | (repeat n 40 | (grdraw (polar cen ang r)(polar cen (setq ang (+ ang angdiv)) r) 1 1) 41 | ) 42 | ) 43 | 44 | 45 | ;;; =======================================================================; 46 | ;;; by qjchen, copy ss according to the direction and vector ; 47 | ;;; =======================================================================; 48 | (defun q:ss:dyngenpolar (sslst n cen ang / i obj1 ss xobj) 49 | (setq ss nil) 50 | (foreach x sslst 51 | (setq xobj (vlax-ename->vla-object x) i 1) 52 | (repeat n 53 | (setq ss (cons (setq obj1 (vla-copy xobj)) ss)) 54 | (Vla-rotate obj1 (vlax-3d-point cen) (* ang i)) 55 | (setq i (1+ i)) 56 | ) 57 | ) 58 | ss 59 | ) 60 | 61 | ;;; =======================================================================; 62 | ;;; selection to list, by Reini Urban ; 63 | ;;; =======================================================================; 64 | (defun std-sslist (ss / n lst) 65 | (if (eq 'pickset (type ss)) 66 | (repeat (setq n (fix (sslength ss))) ; fixed 67 | (setq lst (cons (ssname ss (setq n (1- n))) lst)))) 68 | ) 69 | 70 | (princ "by qjchen@gmail.com, To dynamic rotate copy object, the command is Test") 71 | 72 | 73 | 74 | -------------------------------------------------------------------------------- /bb-图纸分幅.lsp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/bb-图纸分幅.lsp -------------------------------------------------------------------------------- /bzpyj-坐标标注示例.lsp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/bzpyj-坐标标注示例.lsp -------------------------------------------------------------------------------- /b板筋工具V1.0.lsp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/b板筋工具V1.0.lsp -------------------------------------------------------------------------------- /checkbeam.lsp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/checkbeam.lsp -------------------------------------------------------------------------------- /chgtext-批量替换字符.lsp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/chgtext-批量替换字符.lsp -------------------------------------------------------------------------------- /chtext.lsp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/chtext.lsp -------------------------------------------------------------------------------- /ct-写带圆圈数字.lsp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/ct-写带圆圈数字.lsp -------------------------------------------------------------------------------- /cv.lsp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/cv.lsp -------------------------------------------------------------------------------- /dycy-标注序号.lsp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/dycy-标注序号.lsp -------------------------------------------------------------------------------- /fillread-读文件到列表.LSP: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/fillread-读文件到列表.LSP -------------------------------------------------------------------------------- /ft-自动修改字体.LSP: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/ft-自动修改字体.LSP -------------------------------------------------------------------------------- /hzbrea-文字击碎.lsp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/hzbrea-文字击碎.lsp -------------------------------------------------------------------------------- /peditn-修改线弧圆宽度.lsp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/peditn-修改线弧圆宽度.lsp -------------------------------------------------------------------------------- /satwe多层配筋取大归并梁(lgb).LSP: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/satwe多层配筋取大归并梁(lgb).LSP -------------------------------------------------------------------------------- /testa-亮显指定颜色的实体.LSP: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/testa-亮显指定颜色的实体.LSP -------------------------------------------------------------------------------- /tmp-转换坐标系.lsp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/tmp-转换坐标系.lsp -------------------------------------------------------------------------------- /vlx/AB改块基点.VLX: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/vlx/AB改块基点.VLX -------------------------------------------------------------------------------- /vlx/BG标高大师.VLX: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/vlx/BG标高大师.VLX -------------------------------------------------------------------------------- /vlx/CW改宽度.VLX: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/vlx/CW改宽度.VLX -------------------------------------------------------------------------------- /vlx/FS_SS.VLX: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/vlx/FS_SS.VLX -------------------------------------------------------------------------------- /vlx/FWXS(范围选数).VLX: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/vlx/FWXS(范围选数).VLX -------------------------------------------------------------------------------- /vlx/GG GBJ]平法之拉移随心20130723版.VLX: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/vlx/GG GBJ]平法之拉移随心20130723版.VLX -------------------------------------------------------------------------------- /vlx/YX(云线).vlx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/vlx/YX(云线).vlx -------------------------------------------------------------------------------- /vlx/[BBC]梁柱交线处理.VLX: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/vlx/[BBC]梁柱交线处理.VLX -------------------------------------------------------------------------------- /vlx/[GG]平法之拉移随心儿童节.VLX: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/vlx/[GG]平法之拉移随心儿童节.VLX -------------------------------------------------------------------------------- /vlx/[ljbh]梁加编号V1.1.VLX: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/vlx/[ljbh]梁加编号V1.1.VLX -------------------------------------------------------------------------------- /vlx/cb快速建块.VLX: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/vlx/cb快速建块.VLX -------------------------------------------------------------------------------- /vlx/ft图纸归档-批打.VLX: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/vlx/ft图纸归档-批打.VLX -------------------------------------------------------------------------------- /vlx/jggj板钢筋剪断(结构工具).VLX: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/vlx/jggj板钢筋剪断(结构工具).VLX -------------------------------------------------------------------------------- /vlx/zc.VLX: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/vlx/zc.VLX -------------------------------------------------------------------------------- /vlx/华森结构1.06.VLX: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/vlx/华森结构1.06.VLX -------------------------------------------------------------------------------- /vlx/墙柱工具2014-0802.VLX: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/vlx/墙柱工具2014-0802.VLX -------------------------------------------------------------------------------- /vlx/层间归并.VLX: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/vlx/层间归并.VLX -------------------------------------------------------------------------------- /vlx/平法之拉移随心.VLX: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/vlx/平法之拉移随心.VLX -------------------------------------------------------------------------------- /vlx/批量插件快捷键是BPLOT.VLX: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/vlx/批量插件快捷键是BPLOT.VLX -------------------------------------------------------------------------------- /vlx/柱墙填充-TC.VLX: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/vlx/柱墙填充-TC.VLX -------------------------------------------------------------------------------- /vlx/结果导入.VLX: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/vlx/结果导入.VLX -------------------------------------------------------------------------------- /vlx/编译文件: -------------------------------------------------------------------------------- 1 | 编译好的插件 2 | -------------------------------------------------------------------------------- /vlx/计算书归并一(lgb zgb qgb).VLX: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/vlx/计算书归并一(lgb zgb qgb).VLX -------------------------------------------------------------------------------- /vlx/贱人5.8.VLX: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/vlx/贱人5.8.VLX -------------------------------------------------------------------------------- /vlx/（批量打印）BATCHPLOT.VLX: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/vlx/（批量打印）BATCHPLOT.VLX -------------------------------------------------------------------------------- /xscale-XY方向不同比例缩放.lsp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/xscale-XY方向不同比例缩放.lsp -------------------------------------------------------------------------------- /zdt-坐标展点.lsp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/zdt-坐标展点.lsp -------------------------------------------------------------------------------- /《标注工具》之《外包尺寸（WBChC）》V20110620.lsp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/《标注工具》之《外包尺寸（WBChC）》V20110620.lsp -------------------------------------------------------------------------------- /三种大箭头jt.lsp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/三种大箭头jt.lsp -------------------------------------------------------------------------------- /主梁校对(checkbeam).lsp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/主梁校对(checkbeam).lsp -------------------------------------------------------------------------------- /交点打断（br）: -------------------------------------------------------------------------------- 1 | ;;;交点打断 2 | (defun c:br () 3 | (command) 4 | (princ "\n选择要切断的物体:") 5 | (while (setq mid (entsel)) 6 | (setq old-osmode (getvar "osmode")) 7 | (command "_.break" 8 | mid 9 | "F" 10 | (setq pt1 (getpoint "\n输入切断点:")) 11 | (progn (setvar "osmode" 0) pt1) 12 | ) 13 | (setvar "osmode" old-osmode) 14 | ) 15 | ) 16 | -------------------------------------------------------------------------------- /刷文字角度（TT）.lsp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/刷文字角度（TT）.lsp -------------------------------------------------------------------------------- /剪力墙下轴力求和(NHE).LSP: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/剪力墙下轴力求和(NHE).LSP -------------------------------------------------------------------------------- /双向偏移（db）: -------------------------------------------------------------------------------- 1 | ;;;双向偏移 2 | (defun c:db( / en m n pon ename et ppp ouse ) 3 | (setvar "cmdecho" 1) 4 | (COMMAND "OFFSET" PAUSE "") 5 | (prompt "\n Select Objects to Offset: ") 6 | (setq en (ssget)) 7 | (setq m (sslength en )) 8 | (setq n 0) 9 | (setvar "cmdecho" 0) 10 | (repeat m 11 | (setq ename (ssname en n)) 12 | (setq et (entget ename)) 13 | (setq ppp (trans (cdr (assoc 10 et)) 0 1)) 14 | (setq ouse (list ename ppp)) 15 | (setq pon (trans (list (+ (car ppp) 1001) (- (cadr ppp) 1000) ) 0 1 )) 16 | (command "offset" "" ouse pon "") 17 | (setq ouse (list (entlast) (trans (cdr (assoc 10 (entget (entlast)))) 0 1))) 18 | (command "offset" (* (getvar "offsetdist") 2 ) ouse ppp "") 19 | (command "offset" (/ (getvar "offsetdist") 2 ) "") 20 | (setq n (+ n 1)) 21 | ) 22 | ) 23 | -------------------------------------------------------------------------------- /可以生成XREF里面的选定的实体的拷贝(copyn).lsp: -------------------------------------------------------------------------------- 1 | (defun c:copyn (/ blk blks e i lst obj tm ss) 2 | (setq blks (vla-get-blocks 3 | (vla-get-activedocument (vlax-get-acad-object)) 4 | ) 5 | ss (ssadd) 6 | ) 7 | (while (and (setq e (nentselp "Select nested object to copy: ")) 8 | (setq tm (caddr e)) 9 | (setq blk (car (cadddr e))) 10 | (setq blk (vlax-ename->vla-object blk)) 11 | (setq i (vla-item blks (vla-get-name blk))) 12 | ) 13 | (if (= (vla-get-isxref i) :vlax-false) 14 | (vlax-for be i 15 | (if (and (setq e (entget (vlax-vla-object->ename be))) 16 | (not (cdr (assoc 102 e))) 17 | (setq obj (entmakex e)) 18 | (setq obj (vlax-ename->vla-object obj)) 19 | ) 20 | (progn 21 | (vla-transformby obj (vlax-tmatrix tm)) 22 | (setq lst (cons (list obj (vla-get-color obj)) lst)) 23 | (vla-put-color obj 1) 24 | (vla-update obj) 25 | ) 26 | (princ (strcat "\nComplex entity not created [ " 27 | (cdr (assoc 0 e)) 28 | " ]" 29 | ) 30 | ) 31 | ) 32 | ) 33 | (progn 34 | (setq obj (vlax-ename->vla-object (entmakex (entget (car e))))) 35 | (vla-transformby obj (vlax-tmatrix tm)) 36 | (setq lst (cons (list obj (vla-get-color obj)) lst)) 37 | (vla-put-color obj 1) 38 | (vla-update obj) 39 | ) 40 | ) 41 | ) 42 | (if lst 43 | (progn (foreach o lst 44 | ;;(vla-put-color (car o) (cadr o)) 45 | (setq ss (ssadd (vlax-vla-object->ename (car o)) ss)) 46 | (command ".draworder" 47 | (vlax-vla-object->ename (car o)) 48 | "" 49 | "front" 50 | ) 51 | ) 52 | (sssetfirst nil ss) 53 | ) 54 | ) 55 | (princ) 56 | ) -------------------------------------------------------------------------------- /图层冻结管理.lsp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/图层冻结管理.lsp -------------------------------------------------------------------------------- /块属性编辑程序 _chattdef.lsp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/块属性编辑程序 _chattdef.lsp -------------------------------------------------------------------------------- /块改(gkm).lsp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/块改(gkm).lsp -------------------------------------------------------------------------------- /增强复制.lsp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/增强复制.lsp -------------------------------------------------------------------------------- /多义线添加顶点.LSP: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/多义线添加顶点.LSP -------------------------------------------------------------------------------- /多边形标注DBXBZ.lsp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/多边形标注DBXBZ.lsp -------------------------------------------------------------------------------- /多选式图层合并.lsp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/多选式图层合并.lsp -------------------------------------------------------------------------------- /好用-计算并写入线长.lsp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/好用-计算并写入线长.lsp -------------------------------------------------------------------------------- /实体所见即所得（zz）: -------------------------------------------------------------------------------- 1 | ;;;图中实体所见即所得 2 | (defun c:zz (/ YJWSH_CENTERPOINT 3 | YJWSH_CHANGSCALE YJWSH_CHANGSCALE_H 4 | YJWSH_PLOTSCALE YJWSH_SCREENHIGN 5 | YJWSH_SCREENSIZE_Y YJWSH_VIEWCTR 6 | YJWSH_VIEWCTR_NEW YJWSH_VIEWSIZE 7 | ) 8 | (princ 9 | (strcat "\n*** 图中实体所见即所得软件V050308 ***") 10 | ) ;_ 结束princ 11 | (princ (strcat "\n [它山之石图形工作室作品]")) 12 | (princ) 13 | 14 | (setvar "cmdecho" 0) 15 | (princ (strcat "\n请选择视图中心点<退出>")) 16 | (if (setq YJWSh_centerpoint 17 | (getpoint) 18 | ) ;_ 结束setq 19 | (progn 20 | ;;;以下得到当前视口中视图的中心点 21 | (setq YJWSh_viewctr (getvar "viewctr")) 22 | ;;;以下将新得到的视图的中心点移到原来的中心点 23 | (command "pan" YJWSh_centerpoint YJWSh_viewctr) 24 | ;;;以下得到当前视口的视图高度 25 | (setq YJWSh_viewsize (getvar "viewsize")) 26 | ;;;以下得到以像素为单位存储当前视口的大小（X 和 Y 值） 27 | (setq YJWSh_screensize_y (cadr (getvar "screensize"))) 28 | ;;;240(毫米)为用尺子量出的17寸显示器的可视高度，分辩率设为1024X768。 29 | (setq YJWSh_screenhign (* 240 (/ YJWSh_screensize_y 768))) 30 | ;;;以下得到出图比例,也可以通过DIMSCALE变量来设定 31 | (setq YJWSh_plotscale 100) 32 | 33 | (setq YJWSh_changscale_h 34 | (/ (/ YJWSh_viewsize YJWSh_screenhign) 35 | YJWSh_plotscale 36 | ) ;_ 结束/ 37 | ) ;_ 结束setq 38 | (setq YJWSh_changscale (strcat (rtos YJWSh_changscale_h 2 8) "x")) 39 | (command "zoom" YJWSh_changscale) 40 | ) ;_ 结束progn 41 | ) ;_ 结束if 42 | (princ 43 | (strcat "\n*** 图中实体所见即所得软件V050308 ***") 44 | ) ;_ 结束princ 45 | (princ (strcat "\n [它山之石图形工作室作品]")) 46 | (princ) 47 | ) ;_ 结束defun 48 | -------------------------------------------------------------------------------- /对当前图形里的常规词典进行列表(dicts).LSP: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/对当前图形里的常规词典进行列表(dicts).LSP -------------------------------------------------------------------------------- /对象对齐yxpq.lsp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/对象对齐yxpq.lsp -------------------------------------------------------------------------------- /小菜选择易(SS).lsp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/小菜选择易(SS).lsp -------------------------------------------------------------------------------- /小菜选择易.lsp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/小菜选择易.lsp -------------------------------------------------------------------------------- /层工具.lsp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/层工具.lsp -------------------------------------------------------------------------------- /批量实体填充（tcs）.lsp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/批量实体填充（tcs）.lsp -------------------------------------------------------------------------------- /批量注记直线的长度.lsp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/批量注记直线的长度.lsp -------------------------------------------------------------------------------- /改块颜色（se）: -------------------------------------------------------------------------------- 1 | ;;;改块颜色 2 | (defun c:se( / blk blkref blocks doc ent name ss n clo) 3 | (vl-load-com) 4 | (princ "\n选要随层的块: ") 5 | (setq ss (ssget '((0 . "INSERT"))) 6 | n (sslength ss) 7 | ) 8 | (while (and (setq BLK (ssname ss (setq n (1- n)))) 9 | (setq BLKREF (vlax-ename->vla-object BLK)) 10 | (not(and(/= (vla-get-objectname BLKREF) "AcDbBlockReference") 11 | (princ"\n不是块:")) 12 | ) 13 | (setq clo (acad_colordlg 7)) 14 | 15 | (setq name(vla-get-name BLKREF)) 16 | ) 17 | (progn 18 | (command"undo""group") 19 | (setq DOC (vla-get-activedocument (vlax-get-acad-object)) 20 | BLOCKS (vla-get-blocks doc) 21 | blk (vla-item BLOCKS name) 22 | ) 23 | (vlax-for ENT blk 24 | (vla-put-layer ent "0") 25 | (vla-put-color ent clo) 26 | ) 27 | (vla-regen doc acActiveViewport) 28 | (vlax-release-object blk) 29 | (vlax-release-object BLOCKS) 30 | (vlax-release-object DOC) 31 | (command"undo""end") 32 | 33 | ) 34 | ) 35 | (princ"\nUndo后请regen.") 36 | (princ)) 37 | -------------------------------------------------------------------------------- /改斜归正＿专门对付歪门斜道（ GXGZH）.LSP: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/改斜归正＿专门对付歪门斜道（ GXGZH）.LSP -------------------------------------------------------------------------------- /文字与表格对齐TableMulAlign v1.1.lsp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/文字与表格对齐TableMulAlign v1.1.lsp -------------------------------------------------------------------------------- /文字刷（aa）: -------------------------------------------------------------------------------- 1 | ;;;刷文字 2 | (defun c:aa ( / content name_old text_new) 3 | (repeat 1000 4 | (setq content (cdr(assoc 1 (entget(car(entsel"\n 请选择源文字:")))))) 5 | (setq name_old(car(entsel"\n 请选择目标文字:"))) 6 | (setq text_new(entget name_old)) 7 | (setq text_new(subst (cons '1 content) (assoc 1 text_new) text_new)) 8 | (entmake text_new) 9 | (entdel name_old) 10 | (princ) 11 | ) 12 | ) 13 | -------------------------------------------------------------------------------- /文字打断填充ShowHatchTextV1-0.lsp: -------------------------------------------------------------------------------- 1 | ;;-----------------------=={ Show Hatch Text }==------------------------;; 2 | ;; ;; 3 | ;; This program enables the user to clear the area of a hatch pattern ;; 4 | ;; surrounding selected Text or MText objects, or Text, MText or ;; 5 | ;; Attributes contained within selected Block References. ;; 6 | ;; ;; 7 | ;; Upon issuing the command syntax 'sht' (Show Hatch Text) at the ;; 8 | ;; command-line, the user is first prompted to make a selection of ;; 9 | ;; Text, MText and/or Blocks for which to clear the surrounding hatch ;; 10 | ;; pattern, and then to select the obscuring hatch to be modified. ;; 11 | ;; ;; 12 | ;; Following valid selections, the program will proceed to generate ;; 13 | ;; new hatch boundaries surrounding every selected Text and MText ;; 14 | ;; object, and furthermore for every Text, MText or Attribute object ;; 15 | ;; found within each selected block reference, including within any ;; 16 | ;; nested block references (nested to any depth) found within the ;; 17 | ;; selected block references. ;; 18 | ;; ;; 19 | ;; In order to generate the appropriate hatch boundary for nested ;; 20 | ;; Text, MText or Attributes, the program will recreate the nested ;; 21 | ;; object as a temporary primary object, before adding the new hatch ;; 22 | ;; boundary and deleting the temporary object. As a consequence of ;; 23 | ;; this method, the hatch must become disassociative when nested ;; 24 | ;; objects are processed by the program. ;; 25 | ;; ;; 26 | ;;----------------------------------------------------------------------;; 27 | ;; Author: Lee Mac, Copyright ?2013 - www.lee-mac.com ;; 28 | ;;----------------------------------------------------------------------;; 29 | ;; Version 1.0 - 14-11-2013 ;; 30 | ;; ;; 31 | ;; First release. ;; 32 | ;;----------------------------------------------------------------------;; 33 | 34 | (defun c:tcdd ( / cmd en1 en2 ent enx hat idx sel ) 35 | 36 | (defun *error* ( msg ) 37 | (foreach ent en2 38 | (if (entget ent) (entdel ent)) 39 | ) 40 | (if (= 'int (type cmd)) (setvar 'cmdecho cmd)) 41 | (LM:endundo (LM:acdoc)) 42 | (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")) 43 | (princ (strcat "\nError: " msg)) 44 | ) 45 | (princ) 46 | ) 47 | 48 | (LM:startundo (LM:acdoc)) 49 | (cond 50 | ( (= 4 (logand 4 (cdr (assoc 70 (tblsearch "layer" "0"))))) 51 | (princ "\nLayer \"0\" is locked.") 52 | ) 53 | ( (and 54 | (setq sel (LM:ssget "\nSelect text and blocks: " '(((0 . "INSERT,TEXT,MTEXT"))))) 55 | (setq hat (LM:ssget "\nSelect hatch: " '("_+.:E:S:L" ((0 . "HATCH"))))) 56 | ) 57 | (repeat (setq idx (sslength sel)) 58 | (setq ent (ssname sel (setq idx (1- idx))) 59 | enx (entget ent) 60 | ) 61 | (if (wcmatch (cdr (assoc 0 enx)) "*TEXT") 62 | (setq en1 (cons ent en1)) 63 | (progn 64 | (setq en2 65 | (append en2 66 | (fixhatch:processblock 67 | (apply 'fixhatch:tmatrix (refgeom ent)) 68 | (cdr (assoc 2 enx)) 69 | ) 70 | ) 71 | ) 72 | (if (= 1 (cdr (assoc 66 enx))) 73 | (setq en2 (append en2 (fixhatch:processattributes ent))) 74 | ) 75 | ) 76 | ) 77 | ) 78 | (if (or en1 en2) 79 | (progn 80 | (setq cmd (getvar 'cmdecho)) 81 | (setvar 'cmdecho 0) 82 | (if en2 (command "_.-hatchedit" (ssname hat 0) "_DI")) 83 | (command "_.-hatchedit" (ssname hat 0) "_AD" "_S") 84 | (apply 'command (append en1 en2)) 85 | (command "" "") 86 | (setvar 'cmdecho cmd) 87 | (foreach ent en2 (entdel ent)) 88 | ) 89 | ) 90 | ) 91 | ) 92 | (LM:endundo (LM:acdoc)) 93 | (princ) 94 | ) 95 | 96 | (defun fixhatch:processblock ( mat blk / ent enx lst tmp ) 97 | (if (setq ent (tblobjname "block" blk)) 98 | (while (setq ent (entnext ent)) 99 | (setq enx (entget ent)) 100 | (cond 101 | ( (= 1 (cdr (assoc 60 enx)))) 102 | ( (wcmatch (cdr (assoc 0 enx)) "TEXT,MTEXT") 103 | (if (setq tmp (fixhatch:entmakex enx)) 104 | (setq lst (cons tmp lst)) 105 | ) 106 | ) 107 | ( (= "INSERT" (cdr (assoc 0 enx))) 108 | (if (= 1 (cdr (assoc 66 enx))) 109 | (setq lst (append lst (fixhatch:processattributes ent))) 110 | ) 111 | (setq lst 112 | (append lst 113 | (fixhatch:processblock 114 | (apply 'fixhatch:tmatrix (refgeom ent)) 115 | (cdr (assoc 2 enx)) 116 | ) 117 | ) 118 | ) 119 | ) 120 | ) 121 | ) 122 | ) 123 | (foreach ent lst 124 | (vla-transformby (vlax-ename->vla-object ent) mat) 125 | ) 126 | lst 127 | ) 128 | 129 | (defun fixhatch:processattributes ( ent / att atx lst tmp ) 130 | (setq att (entnext ent) 131 | atx (entget att) 132 | ) 133 | (while (= "ATTRIB" (cdr (assoc 0 atx))) 134 | (if 135 | (and (zerop (logand 1 (cdr (assoc 70 atx)))) 136 | (setq tmp 137 | (fixhatch:entmakex 138 | (if (member '(101 . "Embedded Object") atx) 139 | (append '((0 . "MTEXT") (100 . "AcDbEntity") (100 . "AcDbMText")) 140 | (fixhatch:remove1stpairs '(001 007 010 011 040 041 050 071 072 073 210) 141 | (fixhatch:removepairs '(000 002 042 043 051 070 074 100 101 102 280 330 360) atx) 142 | ) 143 | ) 144 | (append '((0 . "TEXT")) 145 | (fixhatch:removepairs '(000 002 070 074 100 280) 146 | (subst (cons 73 (cdr (assoc 74 atx))) (assoc 74 atx) atx) 147 | ) 148 | ) 149 | ) 150 | ) 151 | ) 152 | ) 153 | (setq lst (cons tmp lst)) 154 | ) 155 | (setq att (entnext att) 156 | atx (entget att) 157 | ) 158 | ) 159 | lst 160 | ) 161 | 162 | (defun fixhatch:tmatrix ( mat vec ) 163 | (vlax-tmatrix 164 | (append 165 | (mapcar '(lambda ( a b ) (append a (list b))) mat vec) 166 | '((0.0 0.0 0.0 1.0)) 167 | ) 168 | ) 169 | ) 170 | 171 | (defun fixhatch:entmakex ( enx ) 172 | (entmakex 173 | (append 174 | (vl-remove-if 175 | '(lambda ( x ) 176 | (or (member (car x) '(005 006 008 039 048 062 102 370)) 177 | (= 'ename (type (cdr x))) 178 | ) 179 | ) 180 | enx 181 | ) 182 | '( 183 | (006 . "CONTINUOUS") 184 | (008 . "0") 185 | (039 . 0.0) 186 | (048 . 1.0) 187 | (062 . 7) 188 | (370 . 0) 189 | ) 190 | ) 191 | ) 192 | ) 193 | 194 | (defun fixhatch:removepairs ( itm lst ) 195 | (vl-remove-if '(lambda ( x ) (member (car x) itm)) lst) 196 | ) 197 | 198 | (defun fixhatch:remove1stpairs ( itm lst ) 199 | (vl-remove-if '(lambda ( x ) (if (member (car x) itm) (progn (setq itm (vl-remove (car x) itm)) t))) lst) 200 | ) 201 | 202 | ;; RefGeom (gile) 203 | ;; Returns a list whose first item is a 3x3 transformation matrix and 204 | ;; second item the object insertion point in its parent (xref, block or space) 205 | 206 | (defun refgeom ( ent / ang enx mat ocs ) 207 | (setq enx (entget ent) 208 | ang (cdr (assoc 050 enx)) 209 | ocs (cdr (assoc 210 enx)) 210 | ) 211 | (list 212 | (setq mat 213 | (mxm 214 | (mapcar '(lambda ( v ) (trans v 0 ocs t)) 215 | '( 216 | (1.0 0.0 0.0) 217 | (0.0 1.0 0.0) 218 | (0.0 0.0 1.0) 219 | ) 220 | ) 221 | (mxm 222 | (list 223 | (list (cos ang) (- (sin ang)) 0.0) 224 | (list (sin ang) (cos ang) 0.0) 225 | '(0.0 0.0 1.0) 226 | ) 227 | (list 228 | (list (cdr (assoc 41 enx)) 0.0 0.0) 229 | (list 0.0 (cdr (assoc 42 enx)) 0.0) 230 | (list 0.0 0.0 (cdr (assoc 43 enx))) 231 | ) 232 | ) 233 | ) 234 | ) 235 | (mapcar '- (trans (cdr (assoc 10 enx)) ocs 0) 236 | (mxv mat (cdr (assoc 10 (tblsearch "block" (cdr (assoc 2 enx)))))) 237 | ) 238 | ) 239 | ) 240 | 241 | ;; Matrix Transpose - Doug Wilson 242 | ;; Args: m - nxn matrix 243 | 244 | (defun trp ( m ) 245 | (apply 'mapcar (cons 'list m)) 246 | ) 247 | 248 | ;; Matrix x Matrix - Vladimir Nesterovsky 249 | ;; Args: m,n - nxn matrices 250 | 251 | (defun mxm ( m n ) 252 | ((lambda ( a ) (mapcar '(lambda ( r ) (mxv a r)) m)) (trp n)) 253 | ) 254 | 255 | ;; Matrix x Vector - Vladimir Nesterovsky 256 | ;; Args: m - nxn matrix, v - vector in R^n 257 | 258 | (defun mxv ( m v ) 259 | (mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m) 260 | ) 261 | 262 | ;; ssget - Lee Mac 263 | ;; A wrapper for the ssget function to permit the use of a custom selection prompt 264 | ;; msg - selection prompt 265 | ;; arg - list of ssget arguments 266 | 267 | (defun LM:ssget ( msg arg / sel ) 268 | (princ msg) 269 | (setvar 'nomutt 1) 270 | (setq sel (vl-catch-all-apply 'ssget arg)) 271 | (setvar 'nomutt 0) 272 | (if (not (vl-catch-all-error-p sel)) sel) 273 | ) 274 | 275 | ;; Start Undo - Lee Mac 276 | ;; Opens an Undo Group. 277 | 278 | (defun LM:startundo ( doc ) 279 | (LM:endundo doc) 280 | (vla-startundomark doc) 281 | ) 282 | 283 | ;; End Undo - Lee Mac 284 | ;; Closes an Undo Group. 285 | 286 | (defun LM:endundo ( doc ) 287 | (while (= 8 (logand 8 (getvar 'undoctl))) 288 | (vla-endundomark doc) 289 | ) 290 | ) 291 | 292 | ;; Active Document - Lee Mac 293 | ;; Returns the VLA Active Document Object 294 | 295 | (defun LM:acdoc nil 296 | (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object)))) 297 | (LM:acdoc) 298 | ) 299 | 300 | ;;----------------------------------------------------------------------;; 301 | 302 | (vl-load-com) 303 | (princ 304 | (strcat 305 | "\n:: ShowHatchText.lsp | Version 1.0 | \\U+00A9 Lee Mac " 306 | (menucmd "m=$(edtime,0,yyyy)") 307 | " www.lee-mac.com ::" 308 | "\n:: Type \"sht\" to Invoke ::" 309 | ) 310 | ) 311 | (princ) 312 | 313 | ;;----------------------------------------------------------------------;; 314 | ;; End of File ;; 315 | ;;----------------------------------------------------------------------;; -------------------------------------------------------------------------------- /文字编号修改.lsp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/文字编号修改.lsp -------------------------------------------------------------------------------- /文本动态对齐于曲线.lsp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/文本动态对齐于曲线.lsp -------------------------------------------------------------------------------- /柱填实Column.LSP: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/柱填实Column.LSP -------------------------------------------------------------------------------- /模糊距离合并文字.LSP: -------------------------------------------------------------------------------- 1 | 2 | (defun c:all () 3 | (setq sset nil 4 | sslist nil 5 | ) 6 | (command "layer" "n" "temp" "s" "temp" "") 7 | (command "color" "3") 8 | (setq sset (ssget '((1 . ".")))) 9 | (setq lena (sslength sset) 10 | i 0 11 | ) 12 | (repeat lena 13 | (setq a (ssname sset i)) 14 | (setq pointa (cdr (assoc 11 (entget a)))) 15 | (setq pointc (polar (polar pointa pi 6) (* pi 1.5) 2)) 16 | (setq pointd (polar (polar pointa 0 3) (* pi 0.5) 3)) 17 | (setq sset1 (ssget "w" pointc pointd)) ; (grdraw pointc pointd 4) 18 | (setq sslist nil 19 | sslist1 nil 20 | ) 21 | (setq sslist (std-sslist sset1)) 22 | (setq sslist1 (vl-sort sslist (function (lambda (e1 e2) 23 | (< (car (cdr (assoc 11 24 | (entget e1) 25 | ) 26 | ) 27 | ) (car (cdr (assoc 11 28 | (entget e2) 29 | ) 30 | ) 31 | ) 32 | ) 33 | ) 34 | ) 35 | ) 36 | ) 37 | (if (< (length sslist1) 6) 38 | (progn 39 | (setq m "") 40 | 41 | (foreach x sslist1 42 | (setq m (strcat m (cdr (assoc 1 (entget x))))) 43 | ) 44 | (setq p1 (cdr (assoc 11 (entget (nth 0 sslist1))))) 45 | (command "text" p1 "2.2" "0" m) 46 | ) 47 | ) 48 | (setq i (1+ i)) 49 | ) 50 | ) 51 | 52 | 53 | (defun STD-SSLIST (ss / n lst) 54 | (if (eq 'PICKSET (type ss)) 55 | (repeat (setq n (fix (sslength ss))) ; fixed 56 | (setq lst (cons (ssname ss (setq n (1- n))) lst)) 57 | ) 58 | ) 59 | ) 60 | -------------------------------------------------------------------------------- /相同刷.lsp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/相同刷.lsp -------------------------------------------------------------------------------- /相对路径与完整路径之间相互转化 RepathXrefs 1.0a.lsp: -------------------------------------------------------------------------------- 1 | 2 | ;; RepathXrefs by Joe Burke. 3 | 4 | ;; MISCELLANEOUS NOTES: 5 | 6 | ;; Bug reports may be sent to me directly at lowercase@hawaii.rr.com. 7 | ;; Program updates will be posted at www.theswamp.org under "Show your stuff" 8 | ;; in a topic named "Repath xrefs full or relative". 9 | 10 | ;; The standard disclaimer applies. Use at your own risk... 11 | ;; Please be aware this program is potentially dangerous. 12 | 13 | ;; Requires DOSLib15.arx or later from Robert McNeel & Associates 14 | ;; available for free at www.mcneel.com. Thanks to Dale Fugier. 15 | 16 | ;; Thanks to Steve Doman for suggestions and beta testing. Also 17 | ;; to Jason Piercey for his input. 18 | 19 | ;; Tested with 2002, 2004, 2005, 2006, 2007 and 2008. 20 | 21 | ;; The shortcut is RPX. 22 | 23 | ;; PROGRAM NOTES: 24 | 25 | ;; The general idea is to allow repathing of xrefs by searching for 26 | ;; them within a selected folder. The term "Project" folder refers to 27 | ;; to that folder. It specifies where to search for xrefs. All files 28 | ;; within all sub-folders are included. Typically the Project folder 29 | ;; is one which contains all files and folders related to a particular 30 | ;; project. 31 | 32 | ;; The program is similar to the standalone application Reference Manager 33 | ;; in terms of what it's designed to do. Hopefully users will find this 34 | ;; interface easier to understand. 35 | 36 | ;; Following is a brief example of what search allows. If an xref 37 | ;; is moved from one folder to another within a Project folder, any 38 | ;; file which references it will not be able to find it regardless of 39 | ;; whether the path is full, relative or none. The program can repath 40 | ;; such files to the new location with an option to make the new path 41 | ;; full or relative. 42 | 43 | ;; Another application is a file or files which contain a mix of 44 | ;; relative and full paths. Change all to one or the other. 45 | 46 | ;; Nested xrefs are not repathed because those paths are determined by 47 | ;; the parent xref. In that case run the program on the parent file and 48 | ;; save it. Then reload the parent file in the active file. 49 | 50 | ;; The relative path option requires the Project folder and all files 51 | ;; processed to be on the same drive. This is a standard AutoCAD 52 | ;; limitation which is explained in help. If the relative path drive 53 | ;; condition is not met the program ends with an alert message. 54 | ;; This limitation does not apply to the full path option. 55 | 56 | ;; If an xref is in the same folder as the file referencing it and the 57 | ;; relative path option is chosen then any path is removed. The path will 58 | ;; be the xref file name like the no path option when attaching an xref. 59 | ;; Given a Project folder which contains all files at the Project folder 60 | ;; level, the program will remove all xref paths. 61 | 62 | ;; PROGRAM OPTIONS: 63 | 64 | ;; First option presented at the command line: 65 | ;; Path type [Full/Relative] : 66 | ;; New paths are either Full or Relative. 67 | 68 | ;; Second set of options at the command line when using 2005 or later. 69 | ;; These options are not presented when using 2004 or earlier. 70 | ;; Only xrefs in the active file may be repathed using those versions. 71 | ;; Repath current drawing, all opened drawings, or browse? [Browse/Current/Opened] 72 | ;; If Current is chosen the xrefs in the active file are repathed. 73 | ;; If Opened is chosen all open files are processed. 74 | ;; If Browse is chosen a select files window is presented and the 75 | ;; selected files are processed. 76 | 77 | ;; Third prompt at the command line: 78 | ;; Select Project folder or reuse last Project folder selected if 79 | ;; the program was run at least once before with the active file. 80 | ;; If not the select Project folder window is presented. 81 | 82 | ;; Fourth prompt on screen: 83 | ;; A confirm message box is presented before any files are repathed. 84 | ;; Choose OK to proceed or Cancel to abort. 85 | 86 | ;; Other messages/options which may appear at the command line: 87 | 88 | ;; If multiple copies of an xref are found within the Project folder, 89 | ;; the program will list in the text window where they were found 90 | ;; and the file date. The list is sorted by latest file date first. 91 | ;; Then a question is presented: 92 | ;; Repath using the latest date file? [Yes/No] : 93 | ;; If Yes is chosen the xref file with the latest date is used. 94 | ;; If No is chosen the xref is not repathed in any file which 95 | ;; references it. 96 | 97 | ;; The Browse option allows selection of files which may be saved in 98 | ;; an earlier file format than the version in use. In this case the 99 | ;; files would be saved in the current file format, assuming the file 100 | ;; is not open. Since this may produce undesireable results, such files 101 | ;; are listed in the text window and a question is presented at the 102 | ;; command line: Allow files to change format? [Yes/No] : 103 | ;; if No is chosen the files will not be modified/repathed. 104 | ;; If Yes is chosen the files will be saved in the current version 105 | ;; file format. 106 | 107 | ;; The main reason for the Opened files option is to provide a method 108 | ;; of operating on multiple files while avoiding the change file 109 | ;; format issue. 110 | 111 | ;; REPORTS/EVENTS AT PROGRAM END: 112 | 113 | ;; Xref files which were not found within Project folder are reported, 114 | ;; assuming they are not nested. The total number of repathed xrefs is 115 | ;; displayed. If the Current option is chosen the program reports the 116 | ;; number of nested xrefs found. Otherwise it does not. 117 | 118 | ;; Repathed xrefs in the active file will dynamically update. Xrefs in 119 | ;; open but not active files will not. Either save, close and reopen the 120 | ;; file or reload the xrefs. Note, open files are not saved by the program. 121 | 122 | ;; With the Browse option any file which is either in a newer file format 123 | ;; than the version in use or is marked as read-only by the OS is listed. 124 | ;; Such files are not repathed/modified. 125 | 126 | ;; VERSION HISTORY: 127 | 128 | ;; RepathXrefs 1.0.lsp - 3/7/2008 129 | ;; First release version. 130 | 131 | ;; RepathXrefs 1.0a.lsp - 3/10/2008 132 | ;; Minor bug fix for read-only files under 2007 and 2008 at sub-function 133 | ;; RPX:DocAtPath. 134 | 135 | (vl-load-com) 136 | 137 | (defun c:RepathXrefs ( / *error* fullrel actdoc *acad* files path fullpath 138 | fn docslst filelst temppath reuse temp pathlst 139 | cnt nestcnt datalst masterlst oklst notfoundlst 140 | multiplelst blkname blkobj expath time multans 141 | returnlst msg version formatlst targdoc newerdoclst 142 | documents processpathlst prmpt init rpwhat formatans 143 | lenlst curformat paths 144 | RPX:DocAtPath RPX:Repath RPX:GetDate 145 | RPX:CurrentFileFormat RPX:CheckDOSLib RPX:XrefsData) 146 | ;; globals: *projpath* *OKDOSLib* 147 | 148 | (defun *error* (msg) 149 | (cond 150 | ((not msg)) 151 | ((wcmatch (strcase msg) "*QUIT*,*CANCEL*")) 152 | (T (princ (strcat "\nError: " msg))) 153 | ) 154 | (if 155 | (and 156 | targdoc 157 | (not (vlax-object-released-p targdoc)) 158 | ) 159 | (vlax-release-object targdoc) 160 | ) 161 | (setvar "cmdecho" 1) 162 | (vla-EndUndoMark actdoc) 163 | (if (eq (type dos_waitcursor) 'EXRXSUBR) 164 | (dos_waitcursor) 165 | ) 166 | 167 | (princ) 168 | ) ;end error 169 | 170 | ;;;; START SUB-FUNCTIONS ;;;; 171 | 172 | ;; Argument: document vla-object. 173 | ;; Returns: list of lists: (xreffilename blockname existingpath blockobj) 174 | (defun RPX:XrefsData (doc / blocks blkname fn xreflst expath 175 | NestedXref GetPath) 176 | 177 | ;; Argument: xref block definition vla-object. 178 | ;; Returns: the path property via DXF codes. 179 | ;; Used when the path property is not available in 2004 and earlier. 180 | (defun GetPath (blkdef / elst) 181 | (setq elst (entget (vlax-vla-object->ename blkdef))) 182 | (cdr (assoc 1 (entget (cdr (assoc 360 elst))))) 183 | ) 184 | 185 | ;; Argument: block definition vla-object. 186 | ;; Returns a count number if the xref is nested, otherwise nil. 187 | ;; Based on code by Stephan Koster in a program named XrefTree. 188 | ;; Function renamed from nested_p. 189 | ;; The nestcnt variable is local to the primary routine. 190 | ;; There is a known flaw in the function which Jason pointed out. 191 | ;; If an xref is both nested and referenced as a parent, the 192 | ;; function does not flag it as nested. The fallout from that situation, 193 | ;; if it occurs, should not be a serious problem. 194 | (defun NestedXref (blkdef / elst) 195 | (setq elst (entget (vlax-vla-object->ename blkdef))) 196 | (if 197 | (or 198 | (not (vl-position '(102 . "{BLKREFS") elst)) 199 | (and 200 | (vl-position '(102 . "{BLKREFS") elst) 201 | (not (cdr (assoc 331 elst))) 202 | ) 203 | ) 204 | (if nestcnt (setq nestcnt (1+ nestcnt))) 205 | ;; Else return nil to the parent function. 206 | ) 207 | ) ;end 208 | 209 | (setq blocks (vla-get-blocks doc)) 210 | 211 | (vlax-for x blocks 212 | (if 213 | (and 214 | (= -1 (vlax-get x 'IsXref)) 215 | ;; Filter out nested xrefs. 216 | (not (NestedXref x)) 217 | (setq blkname (vlax-get x 'Name)) 218 | ;; Existing path 219 | (if (vlax-property-available-p x 'Path) 220 | (setq expath (vlax-get x 'Path)) 221 | (setq expath (GetPath x)) 222 | ) 223 | (setq fn (strcat (vl-filename-base expath) ".dwg")) 224 | ) 225 | (setq xreflst (cons (list fn blkname expath x) xreflst)) 226 | ) 227 | ) 228 | xreflst 229 | ) ;end RPX:XrefsData 230 | 231 | ;; Argument: full path. 232 | ;; Returns: date string - 2008/02/08 23:34:18 233 | ;; Use this because vl-file-systime returns nil if a file is open. 234 | (defun RPX:GetDate (path / date year mo day hr mn sec) 235 | (setq date (cdr (car (dos_filedate path))) 236 | date (rtos date 2 6) 237 | year (substr date 1 4) 238 | mo (substr date 5 2) 239 | day (substr date 7 2) 240 | hr (substr date 10 2) 241 | mn (substr date 12 2) 242 | sec (substr date 14 2) 243 | ) 244 | (strcat year "/" mo "/" day " " hr ":" mn ":" sec) 245 | ) 246 | 247 | ;; Used with dos_dwgver to determine if an ODBX doc 248 | ;; will change versions when saved. Update with newer 249 | ;; versions will be needed. 250 | (defun RPX:CurrentFileFormat ( / v) 251 | (setq v (atoi (getvar "acadver"))) 252 | (cond 253 | ((= 15 v) 2000) 254 | ((= 16 v) 2004) 255 | ((= 17 v) 2007) 256 | ((= 18 v) 2010) 257 | (T 2013) 258 | ) 259 | ) 260 | 261 | ;; Added 2/20/2008. 262 | ;; *OKDOSLib* is global so this check need not happen each 263 | ;; time one of the routines is called. Might use (arx) here. 264 | ;; I think "doslib15.arx" contains all these functions. 265 | (defun RPX:CheckDOSLib () 266 | (if 267 | (and 268 | (eq (type dos_waitcursor) 'EXRXSUBR) 269 | (eq (type dos_relativepath) 'EXRXSUBR) 270 | (eq (type dos_getdir) 'EXRXSUBR) 271 | (eq (type dos_ispathsameroot) 'EXRXSUBR) 272 | (eq (type dos_find) 'EXRXSUBR) 273 | (eq (type dos_getfilem) 'EXRXSUBR) 274 | (eq (type dos_msgbox) 'EXRXSUBR) 275 | (eq (type dos_dwgver) 'EXRXSUBR) 276 | (eq (type dos_filedate) 'EXRXSUBR) 277 | ;; Used to check if file is read only 278 | ;; in the RPX:DocAtPath function. 279 | (eq (type dos_file) 'EXRXSUBR) 280 | ) 281 | (setq *OKDOSLib* T) 282 | (progn 283 | (princ "\nDOSLib from Robert McNeel & Associates is required. ") 284 | (princ "\nIt's available for free at www.mcneel.com. ") 285 | (princ "\nExiting... ") 286 | (exit) 287 | ) 288 | ) 289 | ) ;end 290 | 291 | ;; Argument: full path. 292 | ;; Returns a document object. An ODBX doc if the file isn't open. 293 | ;; Otherwise a doc contained in the active documents collection. 294 | ;; Note, an ODBX doc does not have a ReadOnly property. So use 295 | ;; dos_file instead to check for read-only. 296 | (defun RPX:DocAtPath (path / version file srcdoc) 297 | ;check the documents collection 298 | (vlax-for x (vla-get-documents *acad*) 299 | (if 300 | (and 301 | (eq (strcase path) (strcase (vlax-get x 'FullName))) 302 | ;; Check for file marked read-only by the OS. 303 | ;; Though files in the documents collection are not saved, 304 | ;; there's no point repathing a document which can't be saved 305 | ;; by the user. List as read-only at the end of report. 306 | (or 307 | (and 308 | (>= (atoi (getvar "acadver")) 17) 309 | (/= 1 (logand 1 (last (dos_file path)))) 310 | ) 311 | ;; For DOSLib prior to version 7.0. 312 | (and 313 | (< (atoi (getvar "acadver")) 17) 314 | (not (eq "R" (nth 4 (dos_file path)))) 315 | ) 316 | ) 317 | ) 318 | (setq srcdoc x) 319 | ) 320 | ) 321 | ;Otherwise use ObjectDBX. 322 | (if 323 | (and 324 | (not srcdoc) 325 | ;; Check for file marked read-only by the OS. 326 | ;; An attempt to SaveAs such a file causes an error. 327 | (or 328 | (and 329 | (>= (atoi (getvar "acadver")) 17) 330 | (/= 1 (logand 1 (last (dos_file path)))) 331 | ) 332 | (and 333 | (< (atoi (getvar "acadver")) 17) 334 | (not (eq "R" (nth 4 (dos_file path)))) 335 | ) 336 | ) 337 | ) 338 | (cond 339 | ; 2004 or later. Allow for future versions like 340 | ;"ObjectDBX.AxDbDocument.17" by Tony Tanzillo 341 | ((> (setq version (atoi (getvar "AcadVer"))) 15) 342 | (setq srcdoc 343 | (vla-GetInterfaceObject *acad* 344 | (strcat "ObjectDBX.AxDbDocument." (itoa version)))) 345 | ;; Catch the error if file format is later than the version 346 | ;; in use. Return nil. 347 | (if (vl-catch-all-error-p 348 | (vl-catch-all-apply 349 | '(lambda () 350 | (vla-open srcdoc path))) 351 | ) 352 | (setq srcdoc nil) 353 | ) 354 | ) 355 | ;prior to 2004 356 | (T 357 | (if 358 | (and 359 | (vl-catch-all-error-p 360 | (vl-catch-all-apply 361 | 'vla-GetInterfaceObject 362 | (list *acad* "ObjectDBX.AxDbDocument"))) 363 | (setq file (findfile "AxDb15.dll")) 364 | ) 365 | (startapp "regsvr32.exe" (strcat "/s \"" file "\"")) 366 | ) 367 | (setq srcdoc (vla-GetInterfaceObject *acad* "ObjectDBX.AxDbDocument")) 368 | (if (vl-catch-all-error-p 369 | (vl-catch-all-apply 370 | '(lambda () 371 | (vla-open srcdoc path))) 372 | ) 373 | (setq srcdoc nil) 374 | ) 375 | ) 376 | ) 377 | ) 378 | srcdoc 379 | ) ;end 380 | 381 | ;; Arguments: document and a list of lists. 382 | ;; Like this if there's multiple copies of an xref within project folder 383 | ;; ((xreffilename blockname existingpath blkobj) path [path]). 384 | ;; Or one path if there's not. 385 | (defun RPX:Repath (doc lst / xname expath blk fullpath docname docpath 386 | name newpath reportlst) 387 | 388 | (foreach x lst 389 | ;; Xref block name 390 | (setq xname (cadar x)) 391 | ;; Existing path 392 | (setq expath (caddar x)) 393 | ;; xref block vla-object 394 | (setq blk (last (car x))) 395 | ;; If duplicate xrefs found in project folder then this is the 396 | ;; first path among multiple paths which are sorted by date, latest first. 397 | ;; If not it's the only path found. 398 | (setq fullpath (cadr x)) 399 | (if (vl-position doc docslst) 400 | (setq docname (vlax-get doc 'Name) 401 | docpath (vlax-get doc 'Path) 402 | ) 403 | (setq name (vlax-get doc 'Name) 404 | docname (strcat (vl-filename-base name) ".dwg") 405 | docpath (vl-filename-directory name) 406 | ) 407 | ) 408 | 409 | (if (eq "Relative" fullrel) 410 | (progn 411 | (setq newpath 412 | (dos_relativepath 413 | ;; Path to the document passed. 414 | docpath 415 | ;; Full path to xref. 416 | fullpath 417 | ) 418 | ) 419 | ;; Because dos_relativepath returns a path like this 420 | ;; ".\\Plan Bldg B 2 lv KLSC.dwg" when an xref is in the 421 | ;; same folder as the file referencing it. 422 | ;; Remove the leading relative path. 423 | (if (not (vl-string-search "\\" (substr newpath 3))) 424 | (setq newpath (substr newpath 3)) 425 | ) 426 | ) 427 | ;; Else fullrel is "Full" path. 428 | (setq newpath fullpath) 429 | ) 430 | 431 | ;; Check the path found is not the same as the original path. 432 | ;; Repath if not. 433 | (if (not (eq (strcase expath) (strcase newpath))) 434 | (progn 435 | ;; If doc is the active doc use command xref to update xrefs. 436 | ;; Otherwise use ActiveX to repath. 437 | (if (equal doc actdoc) 438 | (command "._xref" "path" xname newpath) 439 | (vlax-put blk 'Path newpath) 440 | ) 441 | 442 | (setq cnt (1+ cnt)) 443 | (setq reportlst (cons (list xname newpath) reportlst)) 444 | ) 445 | ) 446 | 447 | ;; Double check each xref which should have been repathed actually was. 448 | ;; If not try again. In some cases where an xref is both referenced as a 449 | ;; parent and also nested, this will allow repathing the xref. 450 | ;; Without it an xref may be reported as repathed when it was not. 451 | (if (equal doc actdoc) 452 | (foreach x reportlst 453 | (if (not (eq (cadr x) (cdr (assoc 1 (tblsearch "block" xname))))) 454 | (command "._xref" "path" (car x) (cadr x)) 455 | ) 456 | ) 457 | ) 458 | 459 | ) ;foreach 460 | 461 | (if reportlst (list docname reportlst)) 462 | 463 | ) ;end RPX:Repath 464 | ;; ---------------------- 465 | 466 | ;;;; END SUB-FUNCTIONS ;;;; 467 | 468 | ;;;; START MAIN FUNCTION ;;;; 469 | 470 | (if (not *OKDOSLib*) 471 | (RPX:CheckDOSLib) 472 | ) 473 | 474 | (setq *acad* (vlax-get-acad-object) 475 | actdoc (vla-get-ActiveDocument *acad*) 476 | documents (vla-get-Documents *acad*) 477 | ) 478 | 479 | (vla-StartUndoMark actdoc) 480 | 481 | (setq cnt 0) 482 | (setvar "cmdecho" 0) 483 | 484 | (initget "Full Relative") 485 | (setq fullrel (getkword "\nPath type [Full/Relative] : ")) 486 | (if (not fullrel) (setq fullrel "Relative")) 487 | 488 | ;; If 2004 or earlier only the Current option is allowed because 489 | ;; an xref block does not have a path property in those versions. 490 | ;; ACAD 2005 "16.1s (LMS Tech)" 491 | (if (< (atof (getvar "acadver")) 16.1) 492 | (setq rpwhat "Current") 493 | (progn 494 | (if (< 1 (vlax-get documents 'Count)) 495 | (setq prmpt (strcat "\nRepath current drawing, all opened drawings, " 496 | "or browse? [Browse/Current/Opened] : ") 497 | init "Browse Current Opened" 498 | ) 499 | (setq prmpt "\nRepath current drawing or browse? [Browse/Current] : " 500 | init "Browse Current" 501 | ) 502 | ) 503 | (initget init) 504 | (setq rpwhat (getkword prmpt)) 505 | (if (not rpwhat) (setq rpwhat "Browse")) 506 | ) 507 | ) 508 | 509 | ;; Option to reuse of the last project folder selected. 510 | (if *projpath* 511 | (progn 512 | (setq temppath *projpath*) 513 | (princ (strcat "\nCurrent folder: " *projpath*)) 514 | (initget "Yes No") 515 | (setq reuse (getkword "\n Use current Project folder? [Yes/No] : ")) 516 | (if (eq reuse "No") 517 | (setq *projpath* (dos_getdir "Select Project Folder" (getvar "dwgprefix"))) 518 | ) 519 | (if 520 | (and 521 | (eq reuse "No") 522 | (not *projpath*) 523 | ) 524 | (progn 525 | (setq *projpath* temppath) 526 | (exit) 527 | ) 528 | ) 529 | ) 530 | ;else 531 | (if 532 | (not 533 | (setq *projpath* (dos_getdir "Select Project Folder" (getvar "dwgprefix"))) 534 | ) 535 | (exit) 536 | ) 537 | ) 538 | 539 | ;; List of open files. 540 | (vlax-for x documents 541 | (setq docslst (cons x docslst)) 542 | ) 543 | 544 | ;; Browse/Current/Opened 545 | ;; processpathlst is a list of fully qualified paths. 546 | ;; Each is the path to one or more files to be processed. 547 | (cond 548 | ;; Process selected files. 549 | ((eq "Browse" rpwhat) 550 | (if 551 | (not (setq files 552 | (dos_getfilem "Select files" *projpath* 553 | "Drawing files (*.dwg)|*.dwg||"))) 554 | (exit) 555 | (progn 556 | ;; dos_getfilem returns a qualified path first and then 557 | ;; the names of the drawings selected. A single list of strings. 558 | (setq path (car files)) 559 | (foreach fn (cdr files) 560 | (setq processpathlst (cons (strcat path fn) processpathlst)) 561 | ) 562 | ) 563 | ) 564 | ) 565 | ;; Process the documents collection. 566 | ((eq "Opened" rpwhat) 567 | (vlax-for x documents 568 | (setq processpathlst (cons (vlax-get x 'FullName) processpathlst)) 569 | ) 570 | (setq processpathlst (reverse processpathlst)) 571 | ) 572 | ;; Process the active file. 573 | ((eq "Current" rpwhat) 574 | (setq processpathlst (list (vlax-get actdoc 'FullName))) 575 | ) 576 | ) ;cond 577 | 578 | (if 579 | (and 580 | (eq "Relative" fullrel) 581 | (or 582 | (eq "Opened" rpwhat) 583 | (eq "Current" rpwhat) 584 | ) 585 | (not 586 | (vl-every 587 | '(lambda (x) (dos_ispathsameroot *projpath* x)) processpathlst 588 | ) 589 | ) 590 | ) 591 | (progn 592 | (alert 593 | (strcat "The project folder and all open files must be\n" 594 | "on the same drive when using relative paths.\n" 595 | "Please try again. Exiting..." 596 | ) 597 | ) 598 | (exit) 599 | ) 600 | ) 601 | 602 | 603 | (if 604 | (and 605 | (eq "Relative" fullrel) 606 | (eq "Browse" rpwhat) 607 | (not (dos_ispathsameroot *projpath* (car files))) 608 | ) 609 | (progn 610 | (alert 611 | (strcat "The project folder and the selected files must\n" 612 | "be on the same drive when using relative paths.\n" 613 | "Please try again. Exiting..." 614 | ) 615 | ) 616 | (exit) 617 | ) 618 | ) 619 | 620 | ;; List of full paths. 621 | ;; All .dwg files found within project folder sorted by date with newest first. 622 | (setq filelst (dos_find (strcat *projpath* "*.dwg") 4)) 623 | 624 | ;; ------------------------ 625 | ;; ------------------------ 626 | ;; The following code scans the file path list to see if any file 627 | ;; references a file which is duplicated within the Project folder. 628 | ;; Also check the file format of each file to see if the format 629 | ;; will change if saved using ODBX. Also check if any file is in 630 | ;; a newer file format than the version in use. 631 | 632 | ;; Get the current file format. 633 | (setq curformat (RPX:CurrentFileFormat)) 634 | 635 | (foreach x processpathlst 636 | (if (setq targdoc (RPX:DocAtPath x)) 637 | ;; List of lists: (xreffilename blockname existingpath blockobj) 638 | (setq datalst (RPX:XrefsData targdoc)) 639 | ;; if RPX:DocAtPath returns nil the file format is later than 640 | ;; the version in use. This alos catches files which are 641 | ;; marked read-only by the OS. Report at end. 642 | (setq newerdoclst (cons x newerdoclst)) 643 | ) 644 | 645 | ;; Make a list of full paths which would change file format if saved. 646 | ;; Note, dos_dwgver returns "Unknown" if the file format is later 647 | ;; than the version in use. 648 | (if (not (vl-position targdoc docslst)) 649 | (progn 650 | (setq version (dos_dwgver x)) 651 | (if (not (eq "Unknown" version)) 652 | (progn 653 | (setq version (atoi (substr version 9))) 654 | (if 655 | (and 656 | (< version curformat) 657 | (not (vl-position x formatlst)) 658 | ) 659 | (setq formatlst (cons x formatlst)) 660 | ) 661 | ) 662 | ) 663 | ) 664 | ) 665 | 666 | (if 667 | (and 668 | targdoc 669 | (not (vlax-object-released-p targdoc)) 670 | ) 671 | (vlax-release-object targdoc) 672 | ) 673 | 674 | ;; Datalst is a list of lists. 675 | ;; (xreffilename blockname existingpath blockobj) 676 | (foreach x datalst 677 | (setq temp nil 678 | fn (car x) 679 | temp (cons fn temp) 680 | ) 681 | (foreach str filelst 682 | (if (eq (strcase fn) (strcase (strcat (vl-filename-base str) ".dwg"))) 683 | (setq temp (cons str temp)) 684 | ) 685 | ) 686 | (setq temp (reverse temp)) 687 | (if (not (vl-position temp masterlst)) 688 | (setq masterlst (cons temp masterlst)) 689 | ) 690 | ) 691 | ) ;foreach path in processpathlst 692 | 693 | ;; Each item in masterlst is (xreffilename path [path]). It's a list of 694 | ;; lists containing all non-nested xrefs in all selected files. 695 | 696 | ;; List xrefs which have multiple paths. 697 | (foreach x masterlst 698 | (if (< 1 (length (cdr x))) 699 | (setq multiplelst (cons x multiplelst)) 700 | ) 701 | ) 702 | 703 | ;; Each list in multiplelst is like this (xreffilename path [path]). 704 | ;; This part prints to the command line any xrefs involved which are 705 | ;; duplicated in the project folder. 706 | (if multiplelst 707 | (progn 708 | ;; Temp turn off the wait cursor. 709 | (dos_waitcursor) 710 | (textscr) 711 | 712 | (princ "\nDuplicate xrefs found sorted by latest date first. ") 713 | 714 | (foreach x multiplelst 715 | (princ "\n\n -------------- ") 716 | (princ (strcat "\n " (car x))) 717 | (foreach p (cdr x) 718 | (princ (strcat "\n\n" p "\n")) 719 | ; 2008/02/08 23:34:18 720 | (princ (strcat " " (RPX:GetDate p))) 721 | ) 722 | (princ "\n -------------- ") 723 | ) 724 | 725 | ;; Ask the question. 726 | (initget "Yes No") 727 | (setq multans (getkword "\n\nRepath using the latest date file? [Yes/No] : ")) 728 | (if (not multans) (setq multans "Yes")) 729 | 730 | ;; Turn the wait cursor back on. 731 | (dos_waitcursor T) 732 | ) 733 | ) 734 | 735 | (if formatlst 736 | (progn 737 | ;; Temp turn off the wait cursor. 738 | (dos_waitcursor) 739 | (textscr) 740 | 741 | (princ "\nSome selected files will change file format. \n") 742 | 743 | (foreach x formatlst 744 | (princ (strcat "\n " x)) 745 | ) 746 | 747 | (princ "\n") 748 | 749 | ;; Ask the question. 750 | (initget "Yes No") 751 | (setq formatans (getkword "\nAllow files to change format? [Yes/No] : ")) 752 | (if (not formatans) (setq formatans "Yes")) 753 | 754 | ;; Turn the wait cursor back on. 755 | (dos_waitcursor T) 756 | ) 757 | ) 758 | 759 | (if (eq formatans "No") 760 | (foreach x formatlst 761 | (setq processpathlst (vl-remove x processpathlst)) 762 | ) 763 | ) 764 | 765 | ;; End pre-check code. 766 | ;; ------------------------ 767 | ;; ------------------------ 768 | 769 | (setq nestcnt 0) 770 | 771 | ;; Confirm proceed. 772 | ;; Temp turn off the wait cursor. 773 | (dos_waitcursor) 774 | 775 | (cond 776 | ((eq "Current" rpwhat) 777 | (setq msg 778 | (dos_msgbox "Proceed with repathing the current file?" 779 | "Confirm" 2 4 780 | ) 781 | ) 782 | ) 783 | ((eq "Opened" rpwhat) 784 | (setq msg 785 | (dos_msgbox "Proceed with repathing opened files?" 786 | "Confirm" 2 4 787 | ) 788 | ) 789 | ) 790 | ((eq "Browse" rpwhat) 791 | (setq lenlst (length processpathlst)) 792 | (cond 793 | ((= 1 lenlst) 794 | (setq msg 795 | (dos_msgbox 796 | (strcat "Proceed with repathing " (itoa lenlst) " file?") 797 | "Confirm" 2 4 798 | ) 799 | ) 800 | ) 801 | ((< 1 lenlst) 802 | (setq msg 803 | (dos_msgbox 804 | (strcat "Proceed with repathing " (itoa lenlst) " files?") 805 | "Confirm" 2 4 806 | ) 807 | ) 808 | ) 809 | ((= 0 lenlst) 810 | (setq msg 811 | (dos_msgbox 812 | "No files found which need repathing." 813 | "Confirm" 2 4 814 | ) 815 | ) 816 | ) 817 | ) ; end cond 818 | ) 819 | ) ; end cond 820 | 821 | ;; With options in-hand, step through the files again and repath. 822 | 823 | (if (= 4 msg) 824 | (progn 825 | (dos_waitcursor T) 826 | (setq temp nil) 827 | 828 | (foreach x processpathlst 829 | (setq targdoc nil) 830 | (if (setq targdoc (RPX:DocAtPath x)) 831 | ;; List of lists: (xreffilename blockname existingpath blockobj) 832 | (setq datalst (RPX:XrefsData targdoc) 833 | pathlst nil 834 | ) 835 | ) 836 | 837 | ;; datalst is a list of lists 838 | ;; (xreffilename blockname existingpath blockobj) 839 | (foreach x datalst 840 | (setq temp nil 841 | fn (car x) 842 | blkname (cadr x) 843 | expath (caddr x) 844 | blkobj (last x) 845 | temp (cons (list fn blkname expath blkobj) temp) 846 | ) 847 | 848 | ;;;; AVOID scanning the project folder twice. 849 | ;; Do speed test compared to beta 1.15. 850 | (foreach i masterlst 851 | (if (eq fn (car i)) 852 | (setq paths (cdr i)) 853 | ) 854 | ) 855 | 856 | ;; Finally seems right. 857 | (setq pathlst (cons (append temp paths) pathlst)) 858 | 859 | ) 860 | 861 | (setq oklst nil multiplelst nil) 862 | 863 | ;; Each list in pathlst is like this 864 | ;; ((xreffilename blockname existingpath blkobj) path [path]). 865 | ;; Following sorts out which xref files have either a single 866 | ;; path (oklst), no path (notfoundlst) or multiple paths (multiplelst). 867 | (foreach x pathlst 868 | (cond 869 | ((= 1 (length (cdr x))) 870 | (setq oklst (cons x oklst)) 871 | ) 872 | ((= 0 (length (cdr x))) 873 | (setq temp (caar x)) 874 | (if (not (vl-position temp notfoundlst)) 875 | (setq notfoundlst (cons temp notfoundlst)) 876 | ) 877 | ) 878 | ((< 1 (length (cdr x))) 879 | (setq multiplelst (cons x multiplelst)) 880 | ) 881 | ) 882 | ) 883 | 884 | (if (eq multans "Yes") (setq oklst (append multiplelst oklst))) 885 | 886 | (if (and targdoc oklst) 887 | (if (setq temp (RPX:Repath targdoc oklst)) 888 | (setq returnlst (cons temp returnlst)) 889 | ) 890 | ) 891 | 892 | ;; Save ODBX documents. 893 | (if 894 | (and 895 | targdoc 896 | (not (vl-position targdoc docslst)) 897 | ) 898 | (vl-catch-all-apply 'vla-SaveAs (list targdoc x)) 899 | ) 900 | 901 | (if 902 | (and 903 | targdoc 904 | (not (vlax-object-released-p targdoc)) 905 | ) 906 | (vlax-release-object targdoc) 907 | ) 908 | 909 | ) ;end foreach file selected 910 | 911 | ;; ---------------------------- 912 | ;;;; Report ;;;;; 913 | 914 | (textscr) 915 | 916 | ;; typical return list 917 | ; (("A2-102 Bldg C 1 FP KLSC.dwg" (("Plan Bldg B 1 lv KLSC" "..\\Xrefs B\\Plan 918 | ; Bldg B 1 lv KLSC.dwg") ("Border 3624 KLSC" "..\\..\\Common AB\\Xrefs AB\\Border 919 | ; 3624 KLSC.dwg"))) ("A2-101 Bldg B 1 FP KLSC.dwg" (("Plan Bldg B 1 lv KLSC" 920 | ; "..\\Xrefs B\\Plan Bldg B 1 lv KLSC.dwg") ("Border 3624 KLSC" "..\\..\\Common 921 | ; AB\;\Xrefs AB\\Border 3624 KLSC.dwg")))) 922 | 923 | (foreach x (reverse returnlst) 924 | ;; print file name 925 | (princ (strcat "\n\n" (car x))) 926 | ;; xref name and new path 927 | (foreach xr (last x) 928 | (princ (strcat "\n Xref: " (car xr) " repathed: \n")) 929 | (princ (strcat " " (cadr xr))) 930 | ) 931 | ) 932 | 933 | (if notfoundlst 934 | (progn 935 | (princ "\n\nXrefs not found in project folder: ") 936 | (foreach x notfoundlst 937 | (princ (strcat "\n " x)) 938 | ) 939 | ) 940 | ) 941 | 942 | ;; Number of nested xrefs if any. 943 | ;; Only reported with the Current option. 944 | (if (eq "Current" rpwhat) 945 | (if (not (zerop nestcnt)) 946 | (princ (strcat "\n\nNumber of nested xrefs found: " (itoa nestcnt))) 947 | ) 948 | ) 949 | 950 | (princ (strcat "\n\nTotal number of xrefs repathed: " (itoa cnt) "\n")) 951 | 952 | (if newerdoclst 953 | (progn 954 | (princ 955 | (strcat "\nThe following files were not repathed. " 956 | "\n The file format is later than the version in use " 957 | "or the file is read-only. \n" 958 | ) 959 | ) 960 | (foreach x newerdoclst 961 | (princ (strcat "\n " x)) 962 | ) 963 | ) 964 | ) 965 | 966 | ) ;progn 967 | ) ;if msg = 4 968 | 969 | (dos_waitcursor) 970 | 971 | (*error* nil) 972 | 973 | ) ;end RepathXrefs 974 | 975 | ;------------------------------- 976 | ;shortcut 977 | (defun c:RPX () (c:RepathXrefs)) 978 | ;------------------------------- 979 | 980 | ;| 981 | (defun c:LoadedXrefs2 ( / blocks name) 982 | (setq blocks 983 | (vla-get-blocks 984 | (vla-get-activedocument 985 | (vlax-get-acad-object)))) 986 | (vlax-for x blocks 987 | (setq name (vlax-get x 'Name)) 988 | (if (= -1 (vlax-get x 'IsXref)) 989 | (cond 990 | ((not 991 | (vl-catch-all-error-p 992 | (vl-catch-all-apply 993 | 'vlax-get 994 | (list x 'XrefDatabase) 995 | ) 996 | ) 997 | ) 998 | (princ (strcat "\n" name " is loaded. ")) 999 | ) 1000 | (T (princ (strcat "\n" name " is not loaded. "))) 1001 | ) 1002 | ) 1003 | ) 1004 | (princ) 1005 | ) -------------------------------------------------------------------------------- /碰头线.lsp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/碰头线.lsp -------------------------------------------------------------------------------- /编号.lsp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/编号.lsp -------------------------------------------------------------------------------- /让CAD也能实现所见即所得＿源码（ YJWSh）.lsp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/让CAD也能实现所见即所得＿源码（ YJWSh）.lsp -------------------------------------------------------------------------------- /超级剪切（J）: -------------------------------------------------------------------------------- 1 | ;;;超级剪切 2 | (defun c:J (/ PT0 PTLIST PTLIST0 ss CMDECHO OSMODE) 3 | (setq cmdecho (getvar "cmdecho") 4 | osmode (getvar "osmode") 5 | ) 6 | (while (and (setq ptlist0 (getpoint_list)) 7 | (> (length ptlist0) 1) 8 | ) 9 | (setvar "cmdecho" 0) 10 | (setvar "osmode" 0) 11 | (setq pt0 (car ptlist0) 12 | ptlist (cdr ptlist0) 13 | ) 14 | (command "trim" "") 15 | (foreach pt ptlist 16 | (command "f" pt0 pt "") 17 | (setq pt0 pt) 18 | ) 19 | (command "") 20 | (if (setq ss (ssget "f" ptlist0)) 21 | (command "erase" ss "") 22 | ) 23 | (setvar "osmode" osmode) 24 | (setvar "cmdecho" cmdecho) 25 | ) 26 | (princ) 27 | ) 28 | (defun getpoint_list ( / DIS OUT PT) 29 | (setq pt (getpoint "\n开始：")) 30 | (princ "\n按任意键完成:") 31 | (if (= (type pt) 'LIST) 32 | (progn 33 | (setq out (list pt) 34 | dis (* 0.01 (getvar "viewsize"))) 35 | (while (= 5 (car (setq pt (grread t 4 0)))) 36 | (setq pt (cadr pt)) 37 | (if (> (distance pt (car out)) dis) 38 | (progn 39 | (grdraw pt (car out) 1) 40 | (setq out (cons pt out)) 41 | ) 42 | ) 43 | ) 44 | ) 45 | ) 46 | (redraw) 47 | (reverse out) 48 | ) 49 | -------------------------------------------------------------------------------- /超酷剪切.LSP: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/超酷剪切.LSP -------------------------------------------------------------------------------- /连接线段.lsp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/连接线段.lsp -------------------------------------------------------------------------------- /选择易（ss）: -------------------------------------------------------------------------------- 1 | ;;;选择易 2 | (defun c:ss ( / slent f dcl_name lst2 lst1 color tmp index_value flag entl lst3 lst4 code ktmp klst lst4 3 | hand fjflt filter kl_pre ;;原为全局变量，样板实体空选时按上次过滤表进行选择，现用ss_saved_lst保存 4 | ss fjlst ssl attdis strtmp) ;;ss_saved_lst作为全局变量保存上次选择的变量值，格式：(hand fjflt filter kl_pre) 5 | (setq attdis "Y" kl_pre (last ss_saved_lst) slent "N") 6 | (while (= slent "N") 7 | (initget "N") 8 | (setq slent (entsel (strcat "\n请选择样板实体(N-关闭块属性显示,当前状态：" (if (= "Y" attdis) "打开" "关闭") "):" ))) 9 | (if (= slent "N") (setq attdis "N") (setq slent (car slent))) 10 | );;while 11 | (if slent ;;;----------------------1 12 | (progn ;;;-----------------------1 13 | (setq fjflt nil filter nil entl (entget slent)) 14 | (setq lst2 '( 15 | ("通用" ((0 "实体类型") (6 "实体线型") (8 "所在图层") (48 "线型比例") (62 "实体颜色" ((256 "随层") (0 "随块") (1 "红色") (2 "黄色") (3 "绿色") 16 | (4 "青色") (5 "蓝色") (6 "紫色") (7 "黑白"))) (370 "实体线宽"))) 17 | ("ARC" ((-4 "圆弧") (10 "圆心坐标") (40 "圆弧半径") (39 "实体厚度") (50 "起点角度") (51 "终点角度")) ("FJ" ("FJ1" "圆弧长度" (len slent)))) 18 | ("CIRCLE" ((-4 "圆形") (10 "圆心坐标") (40 "圆形半径") (39 "实体厚度"))) 19 | ("SOLID" ((-4 "SOLID") (39 "实体厚度"))) 20 | ("POINT" ((-4 "点") (10 "点的位置") (39 "实体厚度") (50 "旋转角度"))) 21 | ("LINE" ((-4 "直线段") (10 "起点坐标") (11 "终点坐标") (39 "实体厚度")) ("FJ" ("FJ1" "线段长度" (len slent)) 22 | ("FJ2" "线段角度" (REM (ATOF (ANGTOS (ANGLE (DXF 10 slent) (DXF 11 slent)))) 180)))) 23 | ("ELLIPSE" ((-4 "椭圆") (10 "椭圆中心") (11 "长轴端点") (40 "长短轴比") (41 "开始参数") (42 "结束参数"))) 24 | ("INSERT" ((-4 "图块") (10 "图块位置") (2 "图块名称") (41 "X 轴比例") (42 "Y 轴比例") (43 "Z 轴比例") (50 "旋转角度"))) 25 | ;("FJ" ("FJ1" "属性标志" (car (attstr slent))) ("FJ2" "属性数值" (cadr (attstr slent))))) 26 | ("LWPOLYLINE" ((-4 "轻多义线") (38 "复线标高") (43 "固定宽度") (90 "顶点个数") (39 "复线厚度") (70 "是否闭合" ((0 "不闭合") (1 "闭合")))) 27 | ("FJ" ("FJ1" "曲线长度" (len slent)))) 28 | ("POLYLINE" ((-4 "重多义线") (70 "是否闭合" ((0 "不闭合") (1 "闭合")))) ("FJ" ("FJ1" "曲线长度" (len slent )))) 29 | ("HATCH" ((-4 "图案填充") (2 "填充图案") (41 "填充比例") (52 "填充角度") (71 "边界关联" ((0 "不关联") (1 "关联"))) 30 | (76 "图案类型" ((0 "用户定义") (1 "预定义") (2 "自定义"))))) 31 | ("TEXT" ((-4 "文字") (1 "文字内容") (7 "文字样式") (10 "插入位置") (40 "文字高度") (41 "宽度系数") (50 "旋转角度") (51 "倾斜角度") 32 | (71 "文字镜像" ((0 "默认") (2 "文字反向") (4 "文字倒置") (6 "反向倒置"))) 33 | (72 "水平对齐" ((0 "左对齐") (1 "居中对齐") (2 "右对齐") (3 "对齐") (4 "中间") (5 "拟合"))) 34 | (73 "垂直对齐" ((0 "基线对齐") (1 "底端对齐") (2 "居中对齐") (3 "顶端对齐")))) ("FJ" ("FJ1" "文字数值" (ATOF (DXF 1 slent))))) 35 | ("ATTDEF" ((-4 "属性定义") (2 "属性标记") (7 "字型样式") (10 "插入位置") (40 "文字高度") (50 "旋转角度") (51 "倾斜角度") 36 | (71 "文字镜像" ((0 "默认") (2 "文字反向") (4 "文字倒置") (6 "反向倒置"))) 37 | (72 "水平对齐" ((0 "左对齐") (1 "居中对齐") (2 "右对齐") (3 "对齐") (4 "中间") (5 "拟合"))) 38 | (73 "垂直对齐" ((0 "基线对齐") (1 "底端对齐") (2 "居中对齐") (3 "顶端对齐")))) ("FJ" ("FJ1" "标记数值" (ATOF (DXF 2 slent))))) 39 | ("MTEXT" ((-4 "多行文字") (10 "插入位置") (1 "文字内容") (7 "文字样式") (40 "文字高度") (50 "旋转角度"))) 40 | ("SPLINE" ((-4 "样条曲线") (70 "曲线标志") (71 "曲线阶数") (72 "节点数量") (73 "控制点数") (74 "拟合点数") 41 | (42 "节点公差") (43 "控点公差") (44 "拟合公差")) ("FJ" ("FJ1" "曲线长度" (len slent)))) 42 | ("DIMENSION" ((-4 "尺寸标注") (1 "标注文字") (42 "测量值") (3 "标注样式") (70 "标注类型" ((32 "水平垂直") (33 "对齐标注") (34 "角度标注") 43 | (35 "直径标注") (36 "半径标注") (37 "三点角度") (38 "坐标标注"))))) 44 | ) 45 | );;setq lst2 46 | (if (and (= attdis "Y") (= "INSERT" (dxf 0 slent))) (kldc_1)) ;;对块实体，增加属性过滤表，slent及lst2作为全局变量传递 47 | (setq lst3 (car (dxf "通用" lst2)) 48 | lst5 (dxf (dxf 0 entl) lst2) 49 | lst4 (car lst5) 50 | lst5 (cadr lst5) 51 | ) 52 | (foreach tmp lst3 53 | (if (and (not (dxf (car tmp) entl)) (/= (car tmp) 62)) (setq lst3 (vl-remove tmp lst3))) 54 | );;foreach 55 | (setq dcl_name (strcat (getenv "temp") "\\sel" ".dcl") 56 | f (OPEN dcl_name "w")) 57 | (write-line "sl:dialog{label=\"我的选择易--By 小菜\";" f) 58 | (write-line ":column{" f) 59 | (write-line ":boxed_column{label=\"过滤条件\";" f) 60 | (write-line ":boxed_column{label=\"通用\";" f) 61 | (foreach tmp lst3 62 | (write-line ":row{fixed_width=true;" f) 63 | (write-line (strcat ":toggle{key=\"" (itoa (car tmp)) "\";label=\"" (cadr tmp) "\";width=12;}") f) 64 | (write-line (strcat ":popup_list{edit_width=5;key=\"pop" (itoa (car tmp)) "\";}") f) 65 | (setq ktmp (list (strcat "pop" (itoa (car tmp))) (itoa (car tmp)))) 66 | (if (/= 62 (car tmp)) 67 | (progn 68 | (setq ktmp (write f ktmp (car tmp) (vl-princ-to-string (dxf (car tmp) entl)) "txt" "16")) 69 | (if (= 48 (car tmp)) 70 | (setq ktmp (write f ktmp 48 "容差" "txta" "7")) 71 | );;if 72 | );;progn 73 | (progn 74 | (setq color (dxf 62 entl)) (if (not color) (setq color 256)) 75 | (setq ktmp (write f ktmp 62 (itoa color) "txt" "16")) 76 | (write-line (strcat ":edit_box{value=\"" (vl-princ-to-string (car (dxf color (caddr tmp)))) "\";edit_width=7 ;allow_accept=true;}") f) 77 | );progn 78 | );;if 79 | (write-line "}" f) 80 | (setq klst (cons (reverse ktmp) klst)) 81 | );;foreach 82 | (write-line "}" f) 83 | (write-line (strcat ":boxed_column{label=\"" (vl-princ-to-string (car (dxf -4 lst4))) "\";") f) 84 | (setq lst4 (cdr lst4)) ;;去掉前面的-4组码 85 | (foreach tmp lst4 86 | (setq code (car tmp) ktmp nil) 87 | (if (dxf code entl) (progn 88 | (write-line ":row{fixed_width=true;" f) 89 | (setq ktmp (list (strcat "pop" (itoa code)) (itoa code))) 90 | (write-line (strcat ":toggle{key=\"" (itoa code) "\";label=\"" (vl-princ-to-string (cadr tmp)) "\";width=12;}") f) 91 | (write-line (strcat ":popup_list{edit_width=5;key=\"pop" (itoa code) "\";}") f) 92 | (cond ((or (= code 10) (= code 11)) 93 | (setq ktmp (write f ktmp code (vl-princ-to-string (car (dxf code entl))) "txt_x" "6.5")) 94 | (setq ktmp (write f ktmp code (vl-princ-to-string (cadr (dxf code entl))) "txt_y" "6")) 95 | (setq ktmp (write f ktmp code (vl-princ-to-string (caddr (dxf code entl))) "txt_z" "7")) 96 | ) 97 | ((member code '(1 2 3 7 90 38 39 40 41 42 43 44 50 51 52 70 71 72 73 74 76)) 98 | (setq strtmp (vl-princ-to-string (dxf code entl))) 99 | (if (= code 1) 100 | (foreach tmp '("\r\n" "\\P" "\\") 101 | (while (vl-string-search tmp strtmp) (setq strtmp (vl-string-subst " " tmp strtmp))) 102 | );;foreach ;;;;消除acad2005中的mtext中的换行符(shift+enter)导致对话框不正常 103 | );;end if code=1 104 | (setq ktmp (write f ktmp code strtmp "txt" "16")) ;原strtmp=(vl-princ-to-string (dxf code entl)) 105 | (cond ((member code '(38 39 40 41 42 43 44 50 51 52)) 106 | (setq ktmp (write f ktmp code "容差" "txta" "7")) 107 | ) 108 | ((member code '(70 71 72 73 74 76)) 109 | (if (car (dxf (dxf code entl) (cadr (dxf code lst4)))) 110 | (write-line (strcat ":edit_box{value=\"" (vl-princ-to-string (car (dxf (dxf code entl) (cadr (dxf code lst4))))) "\";edit_width=7;allow_accept=true;}") f) 111 | );if 112 | ) 113 | );;cond 114 | ) 115 | );;cond 116 | (write-line "}" f) 117 | ));;progn & if 118 | (if ktmp (setq klst (cons (reverse ktmp) klst))) 119 | );;foreach 120 | (write-line "}" f) 121 | (if lst5 (progn (setq lst5 (cdr lst5) ) ;;去掉lst5第一个元素"FJ" 122 | (write-line ":boxed_column{label=\"附加过滤\";" f) 123 | (foreach tmp lst5 124 | (write-line ":row{fixed_width=true;" f) 125 | (write-line (strcat ":toggle{key=\"" (car tmp) "\";label=\"" (cadr tmp) "\";width=12;}") f) 126 | (write-line (strcat ":popup_list{edit_width=5;key=\"pop" (car tmp) "\";}") f) 127 | (setq ktmp (list (strcat "pop" (car tmp)) (car tmp))) 128 | (setq ktmp (write f ktmp (car tmp) (vl-princ-to-string (eval (caddr tmp))) "txt" "16")) 129 | (setq ktmp (write f ktmp (car tmp) "容差" "txta" "7")) 130 | (setq fjlst (cons (reverse ktmp) fjlst)) ;;fjlst是附加过滤条件的变量表 131 | (write-line "}" f) 132 | );;foreach 133 | (write-line "}" f) 134 | ));if lst5 135 | (write-line "}:row{:boxed_radio_row{label=\"过滤范围\";" f) 136 | (write-line ":radio_button{label=\"手选\";key=\"hand\";value=\"1\";}" f) 137 | (write-line ":radio_button{label=\"预选\";key=\"pre\";}" f) 138 | (write-line ":radio_button{label=\"全图\";key=\"all\";}" f) 139 | (write-line "}}:row{ok_cancel;}}}" f) 140 | (close f) 141 | (setq klst (reverse klst)) 142 | (setq index_value (load_dialog dcl_name));_加载dcl文件 143 | (new_dialog "sl" index_value);_开始新对话框 144 | (foreach tmp klst ;;klst为变量表，第三项开始含有变量名及初始值 145 | ;;如：'(("0" "pop0" ("txt0" "INSERT")) ("8" "pop8" ("txt8" "_消防报警")) ("62" "pop62" ("txt62" "256")) 146 | ;;("10" "pop10" ("txt_x10" "3431.58") ("txt_y10" "-17355.0") ("txt_z10" "0.0")) ("2" "pop2" ("txt2" "RXF008")) 147 | ;;("41" "pop41" ("txt41" "-64.0") ("txta41" "容?.. 148 | (cond ((member (car tmp) '("0" "1" "2" "3" "6" "7" "8")) (show_list (cadr tmp) '("=" "<>"))) 149 | ((member (car tmp) '("10" "11" "38" "39" "40" "41" "42" "43" "44" "48" "50" "51" "52")) (show_list (cadr tmp) '("=" "<" ">" "<=" ">=" "<>"))) 150 | ((member (car tmp) '("62" "70" "71" "72" "73" "74" "76" "90")) (show_list (cadr tmp) '("=" "<" ">" "<=" ">=" "<>" "&" "&="))) 151 | );;cond 152 | );;foreach 显示下拉选单信息 153 | (if fjlst (foreach tmp fjlst (show_list (cadr tmp) '("=" "<" ">" "<=" ">=" "<>"))));;;;end if fjlst;显示附加过滤下拉选单信息 154 | ;;;;fjlst是附加过滤条件的变量表,如：'(("FJ3" "popFJ3" ("txtFJ3" "0.0") ("txtaFJ3" "容差")) ("FJ2" "popFJ2" ("txtFJ2" "0.0") 155 | ;;("txtaFJ2" "容差")) ("FJ1" "popFJ1" ("txtFJ1" "0.0") ("txtaFJ1" "容差"))) 156 | (if kl_pre 157 | (foreach tmp (cdr kl_pre) 158 | (if (= (dxf 0 entl) (car kl_pre)) 159 | (set_tile (car tmp) "1") 160 | (if (member (car tmp) '("0" "6" "8" "48" "62" "370")) 161 | (set_tile (car tmp) "1") 162 | );;end if 163 | );;end if 164 | );;foreach 165 | ) ;;把上次选中的复选框设为选中状态 166 | (action_tile "accept" "(get_filter) (done_dialog 1)") 167 | (setq flag (start_dialog)) 168 | (unload_dialog index_value) 169 | );;end progn ;;;-----------------------1 170 | (setq hand (car ss_saved_lst) 171 | fjflt (cadr ss_saved_lst) 172 | filter (caddr ss_saved_lst) 173 | );;setq 174 | );;end if;;;;--------------------------1 175 | (if filter (progn (princ "\n使用过滤器：") 176 | (princ filter) 177 | (cond ((= hand "1") (setq ss (ssget filter))) 178 | ((= hand "2") (setq ss (ssget "p" filter))) 179 | ((= hand "3") (setq ss (ssget "x" filter))) 180 | );;cond 181 | ));;end if filter 182 | (if (and (setq ssl (chsget ss)) fjflt) 183 | (foreach slent ssl (if (not (eval fjflt)) (setq ss (ssdel slent ss)))) 184 | );;end if 185 | (setq ss_saved_lst (list hand fjflt filter kl_pre)) ;;保存至全局变量 186 | (if ss (progn 187 | (princ (strcat "\n共选中了" (itoa (sslength ss)) "个实体。")) 188 | (if (= 0 (getvar "cmdactive")) (command "select" ss "" "pselect" ss "")) 189 | );;progn 190 | (princ "\n共选中了0个实体。") 191 | );;if 192 | ss 193 | );;defun 194 | (defun get_filter ( / tmp pop txt txt1 rc txt2 txt3 pop_1 pop_2 pop_3) 195 | (cond ((= "1" (get_tile "hand")) (setq hand "1")) 196 | ((= "1" (get_tile "pre")) (setq hand "2")) 197 | ((= "1" (get_tile "all")) (setq hand "3")) 198 | );;cond 199 | (foreach tmp klst (if (/= "1" (get_tile (car tmp))) (setq klst (vl-remove tmp klst)))) 200 | (foreach tmp fjlst (if (/= "1" (get_tile (car tmp))) (setq fjlst (vl-remove tmp fjlst)))) 201 | (setq kl_pre (append (list (dxf 0 entl)) klst fjlst)) ;;附加过滤选中的项下次使用也成为缺省选中 202 | (foreach tmp klst 203 | (setq pop (get_tile (cadr tmp))) 204 | (cond ((member (car tmp) '("0" "1" "2" "3" "6" "7" "8")) 205 | (setq txt (get_tile (caaddr tmp)) 206 | txt1 (cadr (caddr tmp))) 207 | (if (= txt txt1) (setq txt (dxf (read (car tmp)) entl))) ;;如果(car tmp)对应的值未被用户修改过，取回原来的值 208 | (cond ((= pop "0") ;(setq txt (get_tile (caaddr tmp)) 209 | (setq filter (append (cons '(-4 . "")))) filter) 210 | );;setq 211 | ) 212 | ((= pop "1") ; (setq txt (get_tile (caaddr tmp)) 213 | (setq filter (append (cons '(-4 . "")))) filter) 214 | );;setq 215 | ) 216 | );;cond 217 | );;end member 218 | ((member (car tmp) '("62" "70" "71" "72" "73" "74" "76" "90")) 219 | (setq txt (get_tile (caaddr tmp)) 220 | filter (append 221 | (cons (cons -4 (nth (read pop) '("=" "<" ">" "<=" ">=" "<>" "&" "&="))) (list (cons (read (car tmp)) (read txt)))) 222 | filter 223 | );;append 224 | );;setq 225 | ) 226 | ((member (car tmp) '("38" "39" "40" "41" "42" "43" "44" "48" "50" "51" "52")) 227 | (setq txt (get_tile (caaddr tmp)) 228 | txt1 (cadr (caddr tmp)) 229 | rc (read (get_tile (car (last tmp)))) 230 | );;setq 231 | (if (/= txt txt1) (setq txt (atof txt)) (setq txt (dxf (read (car tmp)) entl))) ;;如果(car tmp)对应的值未被用户修改过，取回原来的实数数值 232 | (if (and (or (= (type rc) 'REAL) (= (type rc) 'INT)) (= pop "0")) ;;如果设置了容差，且为数值型，过滤条件为"="时要处理容差 233 | (setq filter (append ;;处理容差 234 | (cons '(-4 . "<=") (list (cons (read (car tmp)) (+ txt (abs rc))))) 235 | (cons '(-4 . ">=") (list (cons (read (car tmp)) (- txt (abs rc))))) 236 | filter 237 | );;append 238 | );;setq 239 | (setq filter (append ;不处理容差 240 | (cons (cons -4 (nth (read pop) '("=" "<" ">" "<=" ">=" "<>"))) (list (cons (read (car tmp)) txt))) 241 | filter 242 | );;append 243 | );;setq 244 | );;end of if 容差 245 | ) 246 | ((member (car tmp) '("10" "11")) 247 | (setq txt1 (get_tile (caaddr tmp)) 248 | txt2 (get_tile (car (cadddr tmp))) 249 | txt3 (get_tile (car (last tmp))) 250 | pop_1 (nth (read pop) '("=" "<" ">" "<=" ">=" "<>")) 251 | pop_2 pop_1 252 | pop_3 pop_1 253 | );;setq 254 | (if (= txt1 "") (setq pop_1 "*")) 255 | (if (= txt2 "") (setq pop_2 "*")) 256 | (if (= txt3 "") (setq pop_3 "*")) 257 | (if (/= txt1 (cadr (caddr tmp))) (setq txt1 (atof txt1)) (setq txt1 (car (dxf (read (car tmp)) entl))));;如果坐标对应的值未被用户修改过，取回原来的实数数值 258 | (if (/= txt2 (cadr (cadddr tmp))) (setq txt2 (atof txt2)) (setq txt2 (cadr (dxf (read (car tmp)) entl)))) 259 | (if (/= txt3 (cadr (last tmp))) (setq txt3 (atof txt3)) (setq txt3 (caddr (dxf (read (car tmp)) entl)))) 260 | (setq filter (append 261 | (cons (cons -4 (strcat pop_1 "," pop_2 "," pop_3)) (list (cons (read (car tmp)) (list txt1 txt2 txt3)))) 262 | filter 263 | ) 264 | ) 265 | );;end of member (car tmp) '("10" "11") 266 | );;cond 267 | );;foreach tmp klst 268 | (if fjlst (progn 269 | (if (null filter) (setq filter (list (assoc 0 entl)))) ;;如果仅选中的附加条件，则将filter设为样板实体的类别 270 | (setq fjflt '(and)) 271 | (foreach tmp fjlst 272 | (setq pop (get_tile (cadr tmp)) 273 | txt (get_tile (caaddr tmp)) 274 | txt1 (cadr (caddr tmp)) 275 | rc (read (get_tile (car (last tmp)))) 276 | );;setq 277 | (if (/= txt txt1) 278 | (if (/= "INSERT" (dxf 0 slent)) (setq txt (atof txt)));图块实体的附加过滤为字符型，其余为数值型 279 | (setq txt (eval (cadr (dxf (car tmp) lst5)))) 280 | ) ;;如果(car tmp)对应的值未被用户修改过，取回原来的实数数值 281 | (if (and (or (= (type rc) 'REAL) (= (type rc) 'INT)) (= pop "0")) ;;如果设置了容差，且为数值型，过滤条件为"="时要处理容差 282 | (setq fjflt (append ;;处理容差 283 | fjflt 284 | (list (list 'and 285 | (list '<= (cadr (dxf (car tmp) lst5)) (+ txt (abs rc))) 286 | (list '>= (cadr (dxf (car tmp) lst5)) (- txt (abs rc))) 287 | )) 288 | );;append 289 | );;setq 290 | (setq fjflt (append ;不处理容差 291 | fjflt 292 | (list (list (read (nth (read pop) '("=" "<" ">" "<=" ">=" "<>"))) (cadr (dxf (car tmp) lst5)) txt)) 293 | );;append 294 | );;setq 295 | );;end of if 容差 296 | );;foreach fjlst 297 | ));;end if fjlst 298 | );;defun 299 | (defun show_list ( key lst) 300 | (start_list key) 301 | (mapcar 'add_list lst) 302 | (end_list) 303 | );;defun 304 | (defun write (f ktmp code value txt width / tmp) 305 | (setq tmp (strcat txt (vl-princ-to-string code))) 306 | (write-line (strcat ":edit_box{value=\"" value "\";key=\"" tmp "\";edit_width=" width ";allow_accept=true;}") f) 307 | (setq ktmp (cons (list tmp value) ktmp)) 308 | );;defun 309 | (defun dxf ( i ent) 310 | (if (= (type ent) 'ENAME) 311 | (setq ent (entget ent)) 312 | ) 313 | (cdr (assoc i ent)) 314 | );;defun 315 | (defun chsget ( c01 / c02 c03 c04 c05) 316 | (if c01 (progn 317 | (setq c02 0 c03 (sslength c01)) 318 | (while (< c02 c03) 319 | (setq c04 (ssname c01 c02) 320 | c02 (1+ c02)) 321 | (setq c05 (cons c04 c05)) 322 | ) ;end of while 323 | ) ;end of progn 324 | ) ;end of if 325 | c05 326 | ) ;end of defun 327 | (defun len (ent) 328 | (if (= (type ent) 'ENAME) (setq ent (vlax-ename->vla-object ent))) 329 | (if (wcmatch (vla-get-ObjectName ent) "AcDbPolyline,AcDbEllipse,AcDbCircle,AcDbArc,AcDbLine,AcDb2dPolyline,AcDbSpline") 330 | (vlax-curve-getdistatparam ent (vlax-curve-getendparam ent)) 331 | );;if 332 | );;defun 333 | (defun VxGetAtts (Obj) 334 | (if (= (type Obj) 'ENAME) (setq Obj (vlax-ename->vla-object Obj))) 335 | (if (= (vla-get-ObjectName obj) "AcDbBlockReference") 336 | (mapcar 337 | '(lambda (Att) 338 | (cons (vla-get-TagString Att) 339 | (vla-get-TextString Att) 340 | ) 341 | ) 342 | (vlax-invoke Obj "GetAttributes") 343 | ) 344 | ) 345 | ) 346 | (defun KLDC_1 (/ attl alen lval ltag aflst aa cc a11 a12 a13) 347 | (setq attl (VxGetAtts slent)) 348 | (if attl (progn 349 | (setq alen (length attl)) 350 | (while (> alen 0) 351 | (setq a11 (list (cons 'nth (cons (- alen 1) '((VxGetAtts slent))))) 352 | a12 (cons 'if (list '(VxGetAtts slent) (cons 'cdr a11))) 353 | a13 (cons 'if (list '(VxGetAtts slent) (cons 'car a11))) 354 | lval (list (strcat "FJ" (rtos (* 2 alen) 2 0)) '"属性数值" a12) 355 | ltag (list (strcat "FJ" (rtos (- (* 2 alen) 1) 2 0)) '"属性标志" a13) 356 | aflst (append (list lval ltag) aflst) 357 | alen (1- alen)) 358 | );;end while 359 | (setq aa (assoc "INSERT" lst2) 360 | cc (list (car aa) (cadr aa) (append '(FJ) (reverse aflst))) 361 | lst2 (subst cc aa lst2)) 362 | );;progn 363 | );;if 364 | );;end defun 365 | (if (not (member "acopm.arx" (arx))) (arxload "acopm.arx")) 366 | (princ) 367 | -------------------------------------------------------------------------------- /镜像mirror(mmi).lsp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xplan001/AutoCad-App/9f94a6e801072e36b005929b232f8cde8e350769/镜像mirror(mmi).lsp --------------------------------------------------------------------------------