;;-------------------------------------------------------------------------------
;;;C:\Program Files\Autodesk2024\AutoCAD 2024\Support\zh-CN
;-指令列表A~Z
;AAAAAAAAAA
;--------------------
;AAA来进行指令提示。
(defun c:AAA()
(princ "\n 快捷指令：")
(princ "\n AAA：啊啊啊，进行指令提示；")
(princ "\n WFF：文找找：文字findfind，非常高级查找文字功能，只能找autocad文字，天正，浩辰等插件文字无法查找到。")
(princ "\n GQT：关其他：关闭选中图层之外的图层。")
(princ "\n TCV：图层visual：图层显示，打开全部图层。")
(princ "\n LM：量Mline的长度，测量多段线长度。")
(princ "\n LLk：连连看：把选中的对象用线段连接起来.")
(princ "\n LLL: 练练线：把所有首尾相连的直线，拼接成多段线。")
(princ "\n LCD：量长度：测量直线、曲线、圆弧等各种形状的长度。")
(princ "\n LLTJ:量量统计：统计线段的长度。")
(princ "\n THB：text合并：文字合并将选中的文字合并成多行文字，不要选太多。")
(princ "\n 企鹅：973490770")
(princ "\n *************显示所有命令快捷键:AAA***************")
(princ "\n LM:标注选择线段的长度")
(princ "\n BCC:备份图纸到当前文件夹，文件名后缀时间，精确到秒")
(princ)
)
(defun c:Bcc (/ sj fn n)
;将cad备份为新的文件，后缀时间例如“新图纸-20240725235717.dwg”；精确到秒。
;这样我们每次画图都可以随时保存备份，而不必担心cad图纸损坏而无法恢复。
(command "qsave" )
(setq sj (getvar "cdate")
sj (* 10000 sj)
sj (rtos sj 2 0)
fn (strcat (getvar "DWGPREFIX") (getvar "DWGNAME"))
n (strlen fn)
fn (substr fn 1 (- n 17))
fn (strcat fn "-" sj ".dwg")
)
(command "saveas" "2018" fn )
;;;保存为2018版本，如果你想保存为低版本可以改成2004
(prompt "文件已经保存；并且另存为：")
(princ fn)
(princ)
)
(defun c:GQT ()
;关闭cad选中对象之外的图层,GQT：关其他
(setq ss (ssget))
(if ss
(progn
(setq selLayer (vla-get-layer (vlax-ename->vla-object (ssname ss 0))))
(setq layers (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))))
(setq layersCount (vla-get-count layers))
(setq layerIndex 0)
(while (< layerIndex layersCount)
(setq currentLayer (vla-item layers layerIndex))
(if (not (equal (vla-get-name currentLayer) selLayer))
(progn
(vla-put-LayerOn currentLayer :vlax-false)
)
)
(setq layerIndex (1+ layerIndex))
)
)
)
(princ)
)
(defun rg-Split (s p / L r)
;正则表达式，来对这样的字符串来分隔成数组"R1011,R1012">-"R1011" "R1012"
(setq r (vlax-create-object "vbscript.regexp"))
(vlax-put-property r 'Global 1)
(vlax-put-property r 'Pattern p)
(read (strcat "(\"" (vlax-invoke r 'Replace s "\" \"") "\")"))
)
(defun c:TFF ()
;DrawLineToUserInputText 将需要查询的文字用","分割，会逐个查询并标记直线
;(setq inputString (getstring "\nEnter the text strings separated by commas: "))
(setq a (getfiled "选择一个文本文件" "F:/F/20230803-山东金城项目/008-李志朋/" "txt" 8))
(setq gaodu (getstring "\n输入文本高度："))
(if gaodu==''
gaodu=500
)
(setq file (open a "r"))
(setq inputString (read-line file))
(setq textStrings (rg-Split inputString ","))
(princ textStrings)
(foreach str1 textStrings
(setq str (substr str1 4 5))
;获得XV-R1101001的R1101
(setq textSet (ssget "X" (list (cons 0 "TEXT") (cons 1 str))))
(if (and textSet (> (sslength textSet) 0))
(if textSet
(progn
(setq ent (ssname textSet 0))
(setq charPoint (cdr (assoc 10 (entget ent))))
(princ charPoint)
(setq endPoint (list (+ (car charPoint) 5000) (+ (cadr charPoint) 40000)))
(princ endpoint)
(command "_line" charPoint endPoint "")
(command "circle" endPoint 10 "")
(command "TEXT" endPoint gaodu 0 str1 )
(setq newPoint (list (+ (car charPoint) 5000) (+ (cadr charPoint) 40000)))
)
(prompt (strcat "\nString not found: " str))
)
)
)
(princ)
)
;001.标注线段长度
(defun c:LM()
(prompt "请选择要标注长度的线段：")
(setq cm (getvar "cmdecho"))
(setvar "cmdecho" 0)
(while (setq ent (car (entsel "\n选取多段线<回车结束>:")))
(setq dxf (entget ent)
nam (cdr (assoc 0 dxf))
)
(if (wcmatch nam "LINE,*POLYLINE,SPLINE,ARC,CIRCLE,ELLIPSE")
(progn
(command "_lengthen" ent "")
(setq cd (getvar "PERIMETER"))
(setq cd (rtos (/ cd 1000) 2 3))
(princ (strcat "\n所选取图元的长度为" cd))
(setq pt (getpoint "\n请指定插入位置点: "))
(command "text" pt 100 0 cd )
)
)
)
(setvar "cmdecho" cm)
(princ)
)
;006.把选中的对象用多段线连接起来-连连看
;作者qq：1434177703
(defun c:LLk ( / e i msg odlst pts ss x)
(vl-load-com)
(setq *ACAD* (vlax-get-acad-object)
*DOC* (vla-get-ActiveDocument *ACAD*)
)
(defun *error*(msg)
(mapcar 'setvar '("cmdecho" "osmode") odlst)
(vlax-invoke-method *DOC* 'EndUndoMark)
(princ msg)
)
(vlax-invoke-method *DOC* 'StartUndoMark)
(setq odlst (mapcar 'getvar '("cmdecho" "osmode")))
(mapcar 'setvar '("cmdecho" "osmode") '(0 0))
(setq ss (ssget '((0 . "TEXT"))))
(setq pts nil)
(repeat (setq i (sslength ss))
(setq e (ssname ss (setq i (1- i))))
(setq pts (cons (cdr (assoc 10 (entget e))) pts))
)
(entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length pts)))
(mapcar '(lambda (x) (cons 10 x)) pts)))
(mapcar 'setvar '("cmdecho" "osmode") odlst)
(vlax-invoke-method *DOC* 'EndUndoMark)
)
;002、所有首尾相连的直曲线创建成一条多段线
(defun c:LLL()
(setvar "peditaccept" 1)
(setq ss (ssget))
(command "pedit" ss "j" "all" "" "")
(setvar "peditaccept" 0)
(princ)
)
;003、量取直线、多段线、样条曲线、圆弧、圆、椭圆的长度。
(defun c:LCD()
(prompt "测量线段长度")
(setq cm (getvar "cmdecho"))
(setvar "cmdecho" 0)
(while (setq ent (car (entsel "\n选取多段线<回车结束>:")))
(setq dxf (entget ent)
nam (cdr (assoc 0 dxf))
)
(if (wcmatch nam "LINE,*POLYLINE,SPLINE,ARC,CIRCLE,ELLIPSE")
(progn
(command "_lengthen" ent "")
(setq cd (getvar "PERIMETER"))
(princ (strcat "\n所选取图元的长度为" (rtos cd 2 3)))
)
)
)
(setvar "cmdecho" cm)
(princ)
)
;004、统计选择线段的总长度。
(defun C:LLTJ (/ CURVE TLEN SS N SUMLEN)
(princ "程序：统计线段长度 命令：zz")
(vl-load-com)
(setq SUMLEN 0)
(setq SS (ssget '((0 . "CIRCLE,ELLIPSE,LINE,*POLYLINE,SPLINE,ARC"))))
(setq N 0)
(repeat (sslength SS)
(setq CURVE (vlax-ename->vla-object (ssname SS N)))
(setq TLEN (vlax-curve-getdistatparam CURVE (vlax-curve-getendparam CURVE)))
(setq SUMLEN (+ SUMLEN TLEN))
(setq N (1+ N)) )
(princ (strcat "\n共选择 " (itoa (sslength SS)) " 条线段. 线段总长: " (rtos SUMLEN 2 3) " .")))
;--------------------
;-------关闭图层
(defun c:GQT ()
(command "layiso" "S" "O" "O")
(princ)
)
;;;*****文字合并 程序开始*****
(defun c:THB (/ lst)
(setq oldaun (getvar "aunits"))
(setvar "aunits" 3)
(setvar "osmode" 15359)
(setvar "cmdecho" 0)
(command "undo" "be")
(princ "\n★功能：文字合并。\n制作者：吴丁运\n")
(setq ss (ssget '((0 . "MTEXT,TEXT"))))
(setvar "osmode" 0)
(initget "E S A")
(if (not (setq kword
(getkword
"\n在合并文字之间加：[换行(E)/空格(S)/直接合并(A)]<E>"
)
)
)
(setq kword "E")
)
(setvar "osmode" 0)
(setq lst '())
(while (> (sslength ss) 0)
(setq entnam (ssname ss 0)
entdat (entget entnam)
)
(setq pt (cdr (assoc 10 entdat)) ;读取文字的插入点坐标
txt (cdr (assoc 1 entdat)) ;读取文字内容
zg (cdr (assoc 40 entdat)) ;读取文字的字高
lst (cons (list pt txt zg) lst) ;将点坐标、内容、字高组成表
ss (ssdel entnam ss) ;选择集中删除当前的文字对象
)
)
(setq
lst
(vl-sort lst
(function
(lambda (e1 e2)
(if (equal (cadr (car e1)) (cadr (car e2)) 1e-4)
(> (car (car e1)) (car (car e2)))
(< (cadr (car e1)) (cadr (car e2)))
)
)
)
)
)
(setq str "")
(cond ((= kword "S")
(foreach e lst
(setq str (strcat (cadr e) " " str))
)
)
((= kword "E")
(foreach e lst
(setq str (strcat (cadr e) "\n" str))
)
)
((= kword "A")
(foreach e lst
(setq str (strcat (cadr e) str))
)
)
)
(setq pt (getpoint "\n请指定点位置:"))
(command "MTEXT" pt "H" zg "W" 0 str "")
(princ "\n★提示:文字合并完成.\n")
(princ)
(setvar "aunits" oldaun)
(command "undo" "e")
(setvar "osmode" 15359)
(princ)
)
;;;*****文字合并 程序结束*****
;;======大师级别程序代码开始，以下代码全部属于lisp祖师爷编写的文字查找功能的代码。
;======我是华丽分割线======================
; Next available MSG number is 104
; MODULE_ID ACAD2005doc_LSP_
;;; ACAD2005DOC.LSP Version 1.0 for AutoCAD 2005
;;;
;;; Copyright (C) 1994 - 2003 by Autodesk, Inc.
;;;
;;; Permission to use, copy, modify, and distribute this software
;;; for any purpose and without fee is hereby granted, provided
;;; that the above copyright notice appears in all copies and
;;; that both that copyright notice and the limited warranty and
;;; restricted rights notice below appear in all supporting
;;; documentation.
;;;
;;; AUTODESK PROVIDES THIS PROGRAM "AS IS" AND WITH ALL FAULTS.
;;; AUTODESK SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY OF
;;; MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE. AUTODESK, INC.
;;; DOES NOT WARRANT THAT THE OPERATION OF THE PROGRAM WILL BE
;;; UNINTERRUPTED OR ERROR FREE.
;;;
;;; Use, duplication, or disclosure by the U.S. Government is subject to
;;; restrictions set forth in FAR 52.227-19 (Commercial Computer
;;; Software - Restricted Rights) and DFAR 252.227-7013(c)(1)(ii)
;;; (Rights in Technical Data and Computer Software), as applicable.
;;;
;;;.
;;;
;;; Note:
;;; This file is loaded automatically by AutoCAD every time
;;; a drawing is opened. It establishes an autoloader and
;;; other utility functions.
;;;
;;; Globalization Note:
;;; We do not support autoloading applications by the native
;;; language command call (e.g. with the leading underscore
;;; mechanism.)
;;;===== Raster Image Support for Clipboard Paste Special =====
;;
;; IMAGEFILE
;;
;; Allow the IMAGE command to accept an image file name without
;; presenting the file dialog, even if filedia is on.
;; Example: (imagefile "c:/images/house.bmp")
;;
(defun imagefile (filename / filedia-save cmdecho-save)
(setq filedia-save (getvar "FILEDIA"))
(setq cmdecho-save (getvar "CMDECHO"))
(setvar "FILEDIA" 0)
(setvar "CMDECHO" 0)
(command "_.-image" "_attach" filename)
(setvar "FILEDIA" filedia-save)
(setvar "CMDECHO" cmdecho-save)
(princ)
)
;;;=== General Utility Functions ===
; R12 compatibility - In R12 (acad_helpdlg) was an externally-defined
; ADS function. Now it's a simple AutoLISP function that calls the
; built-in function (help). It's only purpose is R12 compatibility.
; If you are calling it for anything else, you should almost certainly
; be calling (help) instead.
(defun acad_helpdlg (helpfile topic)
(help helpfile topic)
)
(defun *merr* (msg)
(setq *error* m:err m:err nil)
(princ)
)
(defun *merrmsg* (msg)
(princ msg)
(setq *error* m:err m:err nil)
(princ)
)
;; Loads the indicated ARX app if it isn't already loaded
;; returns nil if no load was necessary, else returns the
;; app name if a load occurred.
(defun verify_arxapp_loaded (app)
(if (not (loadedp app (arx)))
(arxload app f)
)
)
;; determines if a given application is loaded...
;; general purpose: can ostensibly be used for appsets (arx) or (ads) or....
;;
;; app is the filename of the application to check (extension is required)
;; appset is a list of applications, (such as (arx) or (ads)
;;
;; returns T or nil, depending on whether app is present in the appset
;; indicated. Case is ignored in comparison, so "foo.arx" matches "FOO.ARX"
;; Also, if appset contains members that contain paths, app will right-match
;; against these members, so "bar.arx" matches "c:\\path\\bar.arx"; note that
;; "bar.arx" will *not* match "c:\\path\\foobar.arx."
(defun loadedp (app appset)
(cond (appset (or
;; exactly equal? (ignoring case)
(= (strcase (car appset))
(strcase app))
;; right-matching? (ignoring case, but assuming that
;; it's a complete filename (with a backslash before it)
(and
(> (strlen (car appset)) (strlen app))
(= (strcase (substr (car appset)
(- (strlen (car appset))
(strlen app)
)
)
)
(strcase (strcat "\\" app))
)
)
;; no match for this entry in appset, try next one....
(loadedp app (cdr appset)) )))
)
;;; ===== Single-line MText editor =====
(defun LispEd (contents / fname dcl state)
(if (not (setq fname (getvar "program")))
(setq fname "acad")
)
(strcat fname ".dcl")
(setq dcl (load_dialog fname))
(if (not (new_dialog "LispEd" dcl)) (exit))
(set_tile "contents" contents)
(mode_tile "contents" 2)
(action_tile "contents" "(setq contents $value)")
(action_tile "accept" "(done_dialog 1)")
(action_tile "mtexted" "(done_dialog 2)" )
(setq state (start_dialog))
(unload_dialog dcl)
(cond
((= state 1) contents)
((= state 2) -1)
(t 0)
)
)
;;; ===== Discontinued commands =====
(defun c:ddselect(/ cmdecho-save)
(setq cmdecho-save (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(command "._+options" 7)
(setvar "CMDECHO" cmdecho-save)
(princ)
)
(defun c:ddgrips(/ cmdecho-save)
(setq cmdecho-save (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(command "._+options" 7)
(setvar "CMDECHO" cmdecho-save)
(princ)
)
(defun c:gifin ()
(alert "\n不再支持 GIFIN 命令。\n请使用 IMAGE 命令来附着光栅图像文件。\n")
(princ)
)
(defun c:pcxin ()
(alert "\n不再支持 PCXIN 命令。\n请使用 IMAGE 命令来附着光栅图像文件。\n")
(princ)
)
(defun c:tiffin ()
(alert "\n不再支持 TIFFIN 命令。\n请使用 IMAGE 命令来附着光栅图像文件。\n")
(princ)
)
(defun c:ddemodes()
(alert "“对象特性”工具栏包含了 DDEMODES 的功能。\nDDEMODES 已废弃。\n\n欲知详细信息，请从 AutoCAD 帮助的“索引”选项卡中选择“DDEMODES”。")
(princ)
)
(defun c:ddrmodes(/ cmdecho-save)
(setq cmdecho-save (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(command "._+dsettings" 0)
(setvar "CMDECHO" cmdecho-save)
(princ)
)
;;; ===== AutoLoad =====
;;; Check list of loaded <apptype> applications ("ads" or "arx")
;;; for the name of a certain appplication <appname>.
;;; Returns T if <appname> is loaded.
(defun ai_AppLoaded (appname apptype)
(apply 'or
(mapcar
'(lambda (j)
(wcmatch
(strcase j T)
(strcase (strcat "*" appname "*") T)
)
)
(eval (list (read apptype)))
)
)
)
;;
;; Native Rx commands cannot be called with the "C:" syntax. They must
;; be called via (command). Therefore they require their own autoload
;; command.
(defun autonativeload (app cmdliste / qapp)
(setq qapp (strcat "\"" app "\""))
(setq initstring "\n正在初始化...")
(mapcar
'(lambda (cmd / nom_cmd native_cmd)
(progn
(setq nom_cmd (strcat "C:" cmd))
(setq native_cmd (strcat "\"_" cmd "\""))
(if (not (eval (read nom_cmd)))
(eval
(read (strcat
"(defun " nom_cmd "()"
"(setq m:err *error* *error* *merrmsg*)"
"(if (ai_ffile " qapp ")"
"(progn (princ initstring)"
"(_autoarxload " qapp ") (command " native_cmd "))"
"(ai_nofile " qapp "))"
"(setq *error* m:err m:err nil))"
))))))
cmdliste)
nil
)
(defun _autoqload (quoi app cmdliste / qapp symnam)
(setq qapp (strcat "\"" app "\""))
(setq initstring "\n正在初始化...")
(mapcar
'(lambda (cmd / nom_cmd)
(progn
(setq nom_cmd (strcat "C:" cmd))
(if (not (eval (read nom_cmd)))
(eval
(read (strcat
"(defun " nom_cmd "( / rtn)"
"(setq m:err *error* *error* *merrmsg*)"
"(if (ai_ffile " qapp ")"
"(progn (princ initstring)"
"(_auto" quoi "load " qapp ") (setq rtn (" nom_cmd ")))"
"(ai_nofile " qapp "))"
"(setq *error* m:err m:err nil)"
"rtn)"
))))))
cmdliste)
nil
)
(defun autoload (app cmdliste)
(_autoqload "" app cmdliste)
)
(defun autoarxload (app cmdliste)
(_autoqload "arx" app cmdliste)
)
(defun autoarxacedload (app cmdliste / qapp symnam)
(setq qapp (strcat "\"" app "\""))
(setq initstring "\n正在初始化...")
(mapcar
'(lambda (cmd / nom_cmd)
(progn
(setq nom_cmd (strcat "C:" cmd))
(if (not (eval (read nom_cmd)))
(eval
(read (strcat
"(defun " nom_cmd "( / oldcmdecho)"
"(setq m:err *error* *error* *merrmsg*)"
"(if (ai_ffile " qapp ")"
"(progn (princ initstring)"
"(_autoarxload " qapp ")"
"(setq oldcmdecho (getvar \"CMDECHO\"))"
"(setvar \"CMDECHO\" 0)"
"(command " "\"_" cmd "\"" ")"
"(setvar \"CMDECHO\" oldcmdecho))"
"(ai_nofile " qapp "))"
"(setq *error* m:err m:err nil)"
"(princ))"
))))))
cmdliste)
nil
)
(defun _autoload (app)
; (princ "Auto:(load ") (princ app) (princ ")") (terpri)
(load app)
)
(defun _autoarxload (app)
; (princ "Auto:(arxload ") (princ app) (princ ")") (terpri)
(arxload app)
)
(defun ai_ffile (app)
(or (findfile (strcat app ".lsp"))
(findfile (strcat app ".exp"))
(findfile (strcat app ".exe"))
(findfile (strcat app ".arx"))
(findfile app)
)
)
(defun ai_nofile (filename)
(princ
(strcat "\n文件 "
filename
"(.lsp/.exe/.arx) 在搜索路径文件夹中未找到。"
)
)
(princ "\n请检查支持文件的安装，然后重试。")
(princ)
)
;;;===== AutoLoad LISP Applications =====
; Set help for those apps with a command line interface
(autoload "edge" '("edge"))
(setfunhelp "C:edge" "" "edge")
(autoload "3d" '("3d" "3d" "ai_box" "ai_pyramid" "ai_wedge" "ai_dome"
"ai_mesh" "ai_sphere" "ai_cone" "ai_torus" "ai_dish")
)
(setfunhelp "C:3d" "" "3d")
(setfunhelp "C:ai_box" "" "3d_box")
(setfunhelp "C:ai_pyramid" "" "3d_pyramid")
(setfunhelp "C:ai__wedge" "" "3d_wedge")
(setfunhelp "C:ai_dome" "" "3d_dome")
(setfunhelp "C:ai_mesh" "" "3d_mesh")
(setfunhelp "C:ai_sphere" "" "3d_sphere")
(setfunhelp "C:ai_cone" "" "3d_cone")
(setfunhelp "C:ai_torus" "" "3d_torus")
(setfunhelp "C:ai_dish" "" "3d_dish")
(autoload "3darray" '("3darray"))
(setfunhelp "C:3darray" "" "3darray")
(autoload "mvsetup" '("mvsetup"))
(setfunhelp "C:mvsetup" "" "mvsetup")
(autoload "attredef" '("attredef"))
(setfunhelp "C:attredef" "" "attredef")
(autoload "tutorial" '("tutdemo" "tutclear"
"tutdemo"
"tutclear"))
;;;===== AutoArxLoad Arx Applications =====
;;; ===== Double byte character handling functions =====
(defun is_lead_byte(code)
(setq asia_cd (getvar "dwgcodepage"))
(cond
( (or (= asia_cd "dos932")
(= asia_cd "ANSI_932")
)
(or (and (<= 129 code) (<= code 159))
(and (<= 224 code) (<= code 252))
)
)
( (or (= asia_cd "big5")
(= asia_cd "ANSI_950")
)
(and (<= 129 code) (<= code 254))
)
( (or (= asia_cd "gb2312")
(= asia_cd "ANSI_936")
)
(and (<= 161 code) (<= code 254))
)
( (or (= asia_cd "johab")
(= asia_cd "ANSI_1361")
)
(and (<= 132 code) (<= code 211))
)
( (or (= asia_cd "ksc5601")
(= asia_cd "ANSI_949")
)
(and (<= 129 code) (<= code 254))
)
)
)
;;; ====================================================
;;;
;;; FITSTR2LEN
;;;
;;; Truncates the given string to the given length.
;;; This function should be used to fit symbol table names, that
;;; may turn into \U+ sequences into a given size to be displayed
;;; inside a dialog box.
;;;
;;; Ex: the following string:
;;;
;;; "This is a long string that will not fit into a 32 character static text box."
;;;
;;; would display as a 32 character long string as follows:
;;;
;;; "This is a long...tatic text box."
;;;
(defun fitstr2len (str1 maxlen)
;;; initialize internals
(setq tmpstr str1)
(setq len (strlen tmpstr))
(if (> len maxlen)
(progn
(setq maxlen2 (/ maxlen 2))
(if (> maxlen (* maxlen2 2))
(setq maxlen2 (- maxlen2 1))
)
(if (is_lead_byte (substr tmpstr (- maxlen2 2) 1))
(setq tmpstr1 (substr tmpstr 1 (- maxlen2 3)))
(setq tmpstr1 (substr tmpstr 1 (- maxlen2 2)))
)
(if (is_lead_byte (substr tmpstr (- len (- maxlen2 1)) 1))
(setq tmpstr2 (substr tmpstr (- len (- maxlen2 3))))
(setq tmpstr2 (substr tmpstr (- len (- maxlen2 2))))
)
(setq str2 (strcat tmpstr1 "..." tmpstr2))
) ;;; progn
(setq str2 (strcat tmpstr))
) ;;; if
) ;;; defun
;;;
;;; If the first object in a selection set has an attached URL
;;; Then launch browser and point to the URL.
;;; Called by the Grips Cursor Menu
;;;
(defun C:gotourl ( / ssurl url i)
(setq m:err *error* *error* *merrmsg* i 0)
; if some objects are not already pickfirst selected,
; then allow objects to be selected
(if (not (setq ssurl (ssget "_I")))
(setq ssurl (ssget))
)
; if geturl LISP command not found then load arx application
(if (/= (type geturl) 'EXRXSUBR)
(arxload "achlnkui")
)
; Search list for first object with an URL
(while (and (= url nil) (< i (sslength ssurl)))
(setq url (geturl (ssname ssurl i))
i (1+ i))
)
; If an URL has be found, open browser and point to URL
(if (= url nil)
(alert "对象未关联统一资源定位符。")
(command "_.browser" url)
)
(setq *error* m:err m:err nil)
(princ)
)
;; Used by the import dialog to silently load a 3ds file
(defun import3ds (filename / filedia_old render)
;; Load Render if not loaded
(setq render (findfile "acRender.arx"))
(if render
(verify_arxapp_loaded render)
(quit)
)
;; Save current filedia & cmdecho setting.
(setq filedia-save (getvar "FILEDIA"))
(setq cmdecho-save (getvar "CMDECHO"))
(setvar "FILEDIA" 0)
(setvar "CMDECHO" 0)
;; Call 3DSIN and pass in filename.
(c:3dsin 1 filename)
;; Reset filedia & cmdecho
(setvar "FILEDIA" filedia-save)
(setvar "CMDECHO" cmdecho-save)
(princ)
)
;;;----------------------------------------------------------------------------
; New "Select All" function. Cannot be called transparently.
(defun c:ai_selall ( / ss old_error a b old_cmd old_hlt)
(setq a "CMDECHO" b "HIGHLIGHT"
old_cmd (getvar a) old_hlt (getvar b)
old_error *error* *error* ai_error)
(if (ai_notrans)
(progn
(princ "正在选择对象...")
(setvar a 0)
(setvar b 0)
(command "_.SELECT" "_ALL" "") ; Create Previous SS
(setvar a old_cmd)
(setvar b old_hlt)
(setq ss (ssget "_P"))
(sssetfirst ss ss) ; Non-gripped, but selected (someday!)
(princ "完成。\n")
)
)
(setq *error* old_error old_error nil ss nil)
(princ)
)
;;;
;;; Routines that check CMDACTIVE and post an alert if the calling routine
;;; should not be called in the current CMDACTIVE state. The calling
;;; routine calls (ai_trans) if it can be called transparently or
;;; (ai_notrans) if it cannot.
;;;
;;; 1 - Ordinary command active.
;;; 2 - Ordinary and transparent command active.
;;; 4 - Script file active.
;;; 8 - Dialogue box active.
;;;
(defun ai_trans ()
(if (zerop (logand (getvar "cmdactive") (+ 2 8) ))
T
(progn
(alert "不可以透明调用该命令。")
nil
)
)
)
(defun ai_transd ()
(if (zerop (logand (getvar "cmdactive") (+ 2) ))
T
(progn
(alert "不可以透明调用该命令。")
nil
)
)
)
(defun ai_notrans ()
(if (zerop (logand (getvar "cmdactive") (+ 1 2 8) ))
T
(progn
(alert "不可以透明调用该命令。")
nil
)
)
)
;;;----------------------------------------------------------------------------
; New function for invoking the product support help through the browser
(defun C:ai_product_support ()
(setq url "http://www.autodesk.com.cn/autocad-support")
(command "_.browser" url)
)
(defun C:ai_product_support_safe ()
(setq url "http://www.autodesk.com.cn/autocad-support")
(setq 404page "WSProdSupp404.htm")
(command "_.browser2" 404page url)
)
(defun C:ai_training_safe ()
(setq url "http://www.autodesk.com.cn/autocadlt-training")
(setq 404page "WSTraining404.htm")
(command "_.browser2" 404page url)
)
(defun C:ai_custom_safe ()
(setq url "http://www.autodesk.com/developautocad")
(setq 404page "WSCustom404.htm")
(command "_.browser2" 404page url)
)
(defun OtherAppLoad (/)
(princ)
)
;;-------------------------------------------------------------------------------
;;;显示主对话框
;;;****************************************************************************
(defun xsdhk (/ replace )
(setq fn (open (setq lsdcl (VL-FILENAME-MKTEMP "tmp" "" ".dcl")) "w"))
(foreach x '(" czth : dialog{"
" label=\"查找替换 BY YJR111\";"
" :boxed_column {"
" label=\"查找替换\";"
" :row {"
" :popup_list{label=\"查找:\";key=\"18\";width=1;height = 2 ;}"
" :popup_list{label=\"替换:\";key=\"19\";width=1;height = 2 ;}"
" }"
" :row {"
" :edit_box{label=\"查找:\";key=\"oldword\";width = 34 ;height = 1.2 ;allow_accept=true;"
" }"
" :button{key=\"1\";label=\"拾取&Q>>\";width=1;height = 0.8 ;alignment=top;}"
" }"
" :row {"
" :edit_box{label=\"替换:\";key=\"newword\";width = 34.5 ;height = 1.2 ;allow_accept=true;"
" }"
" :button{key=\"2\";label=\"拾取&W>>\";width=1;height = 0.8 ;alignment=top;}"
" }"
" :row {"
" :text{value=\"范围:\";width=1;is_bold=true;}"
" :edit_box{key=\"6\";width=1;}"
" :button{key=\"7\";label=\"选择>\";width=1;}"
" :button{key=\"8\";label=\"全选&F \";width=12;}"
"}"
"}"
" :row {"
" :image{key=\"16\";height=0.2;}"
"}"
" :boxed_row {"
" label=\"查找结果\";"
" :column {"
" :list_box{key=\"9\";height=18;width=36;}"
"}"
" :column {"
" :button{key=\"10\";label=\"上一个&A\";width=1;height=2;}"
" :button{key=\"11\";label=\"下一个&S\";width=1;height=2;}"
" :button{key=\"12\";label=\"替 换&Z\";width=1;height=2;}"
" :button{key=\"3\";label=\"全部替换&Q\";width=15.5;height=2;}"
" :button{key=\"4\";label=\"全部亮显&D\";width=15.5;height=2;}"
" :button{key=\"14\";label=\"删除圆&E\";width=6;height=2;}"
" :button{key=\"15\";label=\"移 除&M\";width=6;height=2;}"
"}"
"}"
":row {"
":text{key=\"wxts\";is_bold=true;}"
"}"
":row{"
":toggle{key=\"tongtihuan\";label=\"固定&W\";width=1;height=2;}"
":edit_box{key=\"onerow\";width=34.2;height=1.4;allow_accept=true;}"
":button{key=\"xiugai\";label=\"修改&X\";width=1;height=2;}"
"}"
" :row {"
" :image{key=\"17\";height=0.2;}"
"}"
" :row {"
" :button{key=\"5\";label=\"选项...\";width=6;height=2;}"
" :image_button{color=3;height=2;key=\"color\";width=4;}"
" :edit_box"
" {"
" label=\"焦距\";"
" key=\"jiaoju\";"
" width = 1 ;"
" height = 1.2 ;"
" }"
" :button{key=\"cancel\";label=\"取消&C\";is_cancel=true;width=1;height=2;}"
" :button{key=\"13\";label=\"帮助&H\";width=1;height=2;}"
" }"
" :row {"
"label=\"焦距动态调节\";"
":slider{key=\"hdt\";value=10;min_value=0;max_value=1000;big_increment=10;small_increment=1;width=1;}"
" }"
"spacer_1;"
"}"
)
(write-line x fn)
)
(close fn)
(setq dclid (load_dialog lsdcl))
(vl-file-delete lsdcl)
(registryREAD);;;注意：读注册表要在对话框显示之前进行
(new_dialog "czth" dclid "" screenpt)
(if(and newch(/= newch ""))newch(setq newch "请输入替换字符串"))
(if(and oldch(/= oldch ""))oldch(setq oldch "请输入查找字符串"))
(if(= wqpp "1")(setq ppzfc oldch)(setq ppzfc (strcat "*" oldch "*")))
(or czls(setq czls "0"))
(or thls(setq thls "0"))
(or drcznr(setq drcznr "0"))
(or tcol(setq tcol 210))
(or tongtihuan(setq tongtihuan "0"))
(or screenpt(setq screenpt '(-1 -1)))
(or wxtsstr(setq wxtsstr "温馨提示:对话框可以移动至合适位置..."))
(and findlst(setq e(nth (atoi drcznr)findlst)))
(if(or(= re 7)(= re 8))(setq replace "0"))
(if (and e (= tongtihuan "0"))
(progn
(getetext)
(set_tile "onerow" etext)
(setq onerow etext)
)
(progn
(set_tile "onerow" newch)
(setq onerow newch)
)
)
(cond
((= re 7)
(setq fw "当前选择")
(setq drcznr "0")
)
((= re 8)
(setq fw "整个图形")
(setq drcznr "0")
)
(t (or fw(setq fw "")))
)
(drawdcl "16" 11)
(drawdcl "17" 11)
(cyczthsz)
(adlst "9" (mapcar 'caddr findlst))
(adlst "18" czstrlst)
(adlst "19" thstrlst)
(zhuangtai)
(c_img "color" tcol)
(set_tile
"color"
(cond ((= (strlen (itoa tcol)) 1) (strcat " " (itoa tcol)))
((= (strlen (itoa tcol)) 2) (strcat " " (itoa tcol)))
((= (strlen (itoa tcol)) 3) (strcat "" (itoa tcol)))
)
)
(set_tile "18" czls)
(set_tile "19" thls)
(set_tile "oldword" oldch)
(set_tile "newword" newch)
(set_tile "jiaoju" jiaoju)
(set_tile "tongtihuan" tongtihuan)
(set_tile "6" fw)
(set_tile "9" drcznr)
(set_tile "wxts" wxtsstr)
(action_tile "color" "(setq tcol (getcolordata tcol))(c_img $key tcol)")
(action_tile "oldword" "(setq oldch $value)(do1)")
(action_tile "newword" "(setq newch $value)(do2)")
(action_tile "jiaoju" "(linkhdt2jiaoju)")
(action_tile "1" "(setq screenpt(done_dialog 1))(wrscreept)")
(action_tile "2" "(setq screenpt(done_dialog 2))(wrscreept)")
(action_tile "3" "(setq screenpt(done_dialog 3))(do2)(wrscreept)")
(action_tile "4" "(setq screenpt(done_dialog 4))(wrscreept)")
(action_tile "5" "(option)")
(action_tile "6" "(setq fw $value)(getfw)")
(action_tile "7" "(setq screenpt(done_dialog 7))(wrscreept)")
(action_tile "8" "(setq screenpt(done_dialog 8))(wrscreept)")
(action_tile "9" "(setq rv1 $reason)(setq drcznr $value)
(if(= rv1 1)(do91))
(if(/= rv1 1)(progn(setq screenpt(done_dialog 9))(wrscreept)))")
(action_tile "10" "(setq up $value)(setq down \"0\")(do10)")
(action_tile "11" "(setq down $value)(setq up \"0\")(do10)")
(action_tile "12" "(setq replace $value)(setq up \"0\")(setq down \"1\")(tihuan findlst)(do2)")
(action_tile "13" "(helpmsg)")
(action_tile "14" "(done_dialog 14)")
(action_tile "15" "(do15)")
(action_tile "18" "(setq czls $value)(do18)")
(action_tile "19" "(setq thls $value)(do19)")
(action_tile "onerow" "(setq onerow $value)")
(action_tile "xiugai" "(xiugai)")
(action_tile "tongtihuan" "(setq tongtihuan $value)(if(= tongtihuan \"1\")(progn(setq onerow newch)(set_tile \"onerow\" newch))) ")
(action_tile "hdt" "(dohdt)")
(action_tile "cancel" "(done_dialog 0)")
(setq re (start_dialog))
(cond
((= re 0) (redraw4)(sssetfirst nil nil)(deleteyuan))
((= re 1) (shiqu))
((= re 2) (shiqu))
((= re 3) (tihuan findlst)(xsdhk))
((= re 4) (LIANGXIAN findlst))
((= re 7) (do7))
((= re 8) (do1)(do8))
((= re 9) (do9))
((= re 14) (deleteyuan2)(xsdhk))
)
(unload_dialog dclid)
);_ END xsdhk
;;;******************************************
;;;显示选项对话框
;;;******************************************
(defun option()
(setq fn (open (setq lsdcl (VL-FILENAME-MKTEMP "tmp" "" ".dcl")) "w"))
(foreach x '(" sz : dialog{"
" label=\"条件设置\";"
" :boxed_row {"
" :toggle"
" {"
" label=\"完全匹配 \";"
" key=\"wqpp\";"
" height = 1.2 ;"
" allow_accept=true;"
" }"
" :toggle"
" {"
" label=\"区分大小写\";"
" key=\"qfdxx\";"
" height = 1.2 ;"
" allow_accept=true;"
" }"
" }"
" :boxed_column {"
" :row {"
" :toggle"
" {"
" label=\"单行文字\";"
" key=\"dhwz\";"
" height = 1.2 ;"
" allow_accept=true;"
" }"
" :toggle"
" {"
" label=\"多行文字\";"
" key=\"duohwz\";"
" height = 1.2 ;"
" allow_accept=true;"
" }"
" }"
" :row {"
" :toggle"
" {"
" label=\"属性文字\";"
" key=\"sxwz\";"
" height = 1.2 ;"
" allow_accept=true;"
" }"
" :toggle"
" {"
" label=\"天正文字\";"
" key=\"tzwz\";"
" height = 1.2 ;"
" allow_accept=true;"
" }"
" }"
" :row {"
" :toggle"
" {"
" label=\"块内文字\";"
" key=\"knwz\";"
" height = 1.2 ;"
" allow_accept=true;"
" }"
" :toggle"
" {"
" label=\"其他文字\";"
" key=\"tzqt\";"
" height = 1.2 ;"
" allow_accept=true;"
" }"
" }"
" }"
" :boxed_column {"
" label=\"历史记录设置(字符之间以空格分隔)\";"
" :edit_box{label=\"常用查找\";key=\"cycz\";width = 34 ;height = 1.2 ;allow_accept=true;}"
" :edit_box{label=\"常用替换\";key=\"cyth\";width = 34 ;height = 1.2 ;allow_accept=true;}"
"}"
" :row {"
" :toggle{label=\"清空查找结果\";key=\"qk\";}"
" ok_cancel;"
"}"
"}"
)
(write-line x fn)
)
(close fn)
(setq dclid (LOAD_DIALOG lsdcl))
(VL-FILE-DELETE lsdcl)
(registryREAD)
(new_dialog "sz" dclid )
(set_tile "wqpp" wqpp)
(set_tile "qfdxx" qfdxx)
(set_tile "dhwz" dhwz)
(set_tile "duohwz" duohwz)
(set_tile "sxwz" sxwz)
(set_tile "tzwz" tzwz)
(set_tile "knwz" knwz)
(set_tile "tzqt" tzqt)
(set_tile "cycz" cycz)
(set_tile "cyth" cyth)
(set_tile "qk" qk)
(action_tile "wqpp" "(setq wqpp $value)")
(action_tile "qfdxx" "(setq qfdxx $value)")
(action_tile "dhwz" "(setq dhwz $value)")
(action_tile "duohwz" "(setq duohwz $value)")
(action_tile "sxwz" "(setq sxwz $value)")
(action_tile "tzwz" "(setq tzwz $value)")
(action_tile "knwz" "(setq knwz $value)")
(action_tile "tzqt" "(setq tzqt $value)")
(action_tile "cycz" "(docycz)")
(action_tile "cyth" "(docyth)")
(action_tile "qk" "(setq qk $value)")
(action_tile "accept" "(done_dialog 100)")
(action_tile "cancel" "(done_dialog 0)")
(setq std(START_DIALOG))
(cond((= std 100)
(registrywrite)
)
)
(cyczthsz)
(unload_dialog dclid)
)
;;;***************************************************************
;;;常用查找替换字符串设置
;;;***************************************************************
(defun cyczthsz()
(if (and cycz (/= cycz ""))
(progn
(setq czcylst(str->lst cycz " "))
(foreach x czcylst
(if (and x(not(member x czstrlst)))
(setq czstrlst(cons x czstrlst))
)
)
(adlst "18" czstrlst)
(set_tile "18" "0")
(set_tile "oldword" (car czstrlst))
)
)
(if (and cyth (/= cyth ""))
(progn
(setq thcylst(str->lst cyth " "))
(foreach x thcylst
(if (and x(not(member x thstrlst)))
(setq thstrlst(cons x thstrlst))
)
)
(adlst "19" thstrlst)
(set_tile "19" "0")
(set_tile "newword" (car thstrlst))
)
)
)
;;;******************************************
;;;定义e
;;;******************************************
(defun gete()
(setq e(nth (atoi drcznr)findlst))
)
;;;******************************************
;;;定义etext
;;;******************************************
(defun getetext()
(setq etext (substr (caddr e)(1+(strlen(strcat"["(itoa(1+(atoi drcznr)))"] ")))))
)
;;;**********************************************
;;;字符串转表
;;;str:字符串 sign字符串分割标记，例如"1 2 3 4"->("1" "2" "3" "4")
;;;**********************************************
(defun str->lst(str sign / position lst)
(while (and str(/= str ""))
(if(setq position (vl-string-search sign str))
(progn
(setq lst (append lst (list (substr str 1 position))))
(setq str (substr str (+ 2 position)))
)
(progn
(setq lst (append lst (list str )))
(setq str nil)
)
)
)
lst
)
;|选择集筛选函数 by firstinti
http://bbs.mjtd.com/thread-93264-1-1.html
ss-原始总选择集
vartxtlst-各分类选择集变量名列表
filterlst-各分类选择集类型
(setq ss (ssget))
(setq vartxtlst (list "ss1" "ss2" "ss3")
filterlst (list "circle" "*line" "*text")
)
用法:(ssgflt ss vartxtlst filterlst)
|;
(defun ssgflt(ss vartxtlst filterlst)
(defun wmg-ssgetp (ss filter)
(if ss(vl-cmdf "select" ss ""))
(ssget "p" (list (cons 0 filter)))
)
(mapcar (function (lambda (x y) (set x (wmg-ssgetp ss y))))
(mapcar 'read vartxtlst)
filterlst
)
)
;;;**********************************************
;;;写注册表对话框位置
;;;**********************************************
(defun wrscreept()
(and screenpt(vl-registry-write "HKEY_CURRENT_USER\\czthoption" "screenpt" (vl-princ-to-string screenpt)))
)
;;;**********************************************
;;;写注册表选项配置
;;;**********************************************
(defun registrywrite()
(and wqpp(vl-registry-write "HKEY_CURRENT_USER\\czthoption" "wqpp" wqpp))
(and qfdxx(vl-registry-write "HKEY_CURRENT_USER\\czthoption" "qfdxx" qfdxx))
(and dhwz(vl-registry-write "HKEY_CURRENT_USER\\czthoption" "dhwz" dhwz))
(and duohwz(vl-registry-write "HKEY_CURRENT_USER\\czthoption" "duohwz" duohwz))
(and sxwz(vl-registry-write "HKEY_CURRENT_USER\\czthoption" "sxwz" sxwz))
(and tzwz(vl-registry-write "HKEY_CURRENT_USER\\czthoption" "tzwz" tzwz))
(and knwz(vl-registry-write "HKEY_CURRENT_USER\\czthoption" "knwz" knwz))
(and tzqt(vl-registry-write "HKEY_CURRENT_USER\\czthoption" "tzqt" tzqt))
(vl-registry-write "HKEY_CURRENT_USER\\czthoption" "cycz" cycz)
(vl-registry-write "HKEY_CURRENT_USER\\czthoption" "cyth" cyth)
(vl-registry-write "HKEY_CURRENT_USER\\czthoption" "qk" qk)
)
;;;**********************************************
;;;读注册表选项配置
;;;**********************************************
(DEFUN registryREAD()
(or (setq wqpp (vl-registry-read "HKEY_CURRENT_USER\\czthoption" "wqpp"))(setq wqpp "0"))
(or (setq qfdxx (vl-registry-read "HKEY_CURRENT_USER\\czthoption" "qfdxx"))(setq qfdxx "0"))
(or (setq dhwz (vl-registry-read "HKEY_CURRENT_USER\\czthoption" "dhwz"))(setq dhwz "1"))
(or (setq duohwz (vl-registry-read "HKEY_CURRENT_USER\\czthoption" "duohwz"))(setq duohwz "1"))
(or (setq sxwz (vl-registry-read "HKEY_CURRENT_USER\\czthoption" "sxwz"))(setq sxwz "0"))
(or (setq tzwz (vl-registry-read "HKEY_CURRENT_USER\\czthoption" "tzwz"))(setq tzwz "0"))
(or (setq knwz (vl-registry-read "HKEY_CURRENT_USER\\czthoption" "knwz"))(setq knwz "0"))
(or (setq tzqt (vl-registry-read "HKEY_CURRENT_USER\\czthoption" "tzqt"))(setq tzqt "0"))
(or (setq cycz (vl-registry-read "HKEY_CURRENT_USER\\czthoption" "cycz"))(setq cycz ""))
(or (setq cyth (vl-registry-read "HKEY_CURRENT_USER\\czthoption" "cyth"))(setq cyth ""))
(or (setq qk (vl-registry-read "HKEY_CURRENT_USER\\czthoption" "qk"))(setq qk "0"))
(or (setq jiaoju (vl-registry-read "HKEY_CURRENT_USER\\czthoption" "jiaoju"))(setq jiaoju "10"))
(if(setq screenpt(vl-registry-read "HKEY_CURRENT_USER\\czthoption" "screenpt"))
(setq screenpt (read(vl-registry-read "HKEY_CURRENT_USER\\czthoption" "screenpt")))
(setq screenpt '(-1 -1))
)
)
;;;**************************************************
;;;状态显示
;;;**************************************************
(defun zhuangtai()
(IF FINDLST
(PROGN
(MODE_TILE "3" 0)
(MODE_TILE "4" 0)
(MODE_TILE "10" 0)
(MODE_TILE "11" 0)
(MODE_TILE "12" 0)
(MODE_TILE "15" 0)
(MODE_TILE "hdt" 0)
(MODE_TILE "xiugai" 0)
)
(PROGN
(MODE_TILE "3" 1)
(MODE_TILE "4" 1)
(MODE_TILE "10" 1)
(MODE_TILE "11" 1)
(MODE_TILE "12" 1)
(MODE_TILE "15" 1)
(MODE_TILE "hdt" 1)
(MODE_TILE "xiugai" 1)
)
)
(if (ssget "x" (list (cons 0 "ellipse") (cons 8 "findttz")))
(MODE_TILE "14" 0)
(MODE_TILE "14" 1)
)
(mode_tile "6" 1)
)
;;;**************************************************
;;;常用查找历史记录设置
;;;**************************************************
(defun docycz()
(setq cycz $value)
)
;;;**************************************************
;;;常用替换历史记录设置
;;;**************************************************
(defun docyth()
(setq cyth $value)
)
;;;**************************************************
;;;屏幕提取文字
;;;**************************************************
(defun shiqu(/ ent1 enttext s )
(setq ent1 (nentsel"\n请点击文字提取:"))
(if (and ent1(wcmatch(cdr(assoc 0 (setq s(entget (car ent1)))))"*TEXT,ATTREF,ATTRIB"))
(progn
(setq enttext (cdr (assoc 1 s)))
(if (= re 1)(setq oldch enttext))
(if (= re 2)(setq newch enttext))
)
)
(xsdhk)
)
;;;******************************************
;;;在DCL上画画
;;;******************************************
(defun drawdcl(key dclcol / n)
(setq width (dimx_tile key)
height (dimy_tile key)
)
(start_image key)
(vector_image 0 0 width 0 dclcol)
(vector_image 0 0 0 height dclcol)
(vector_image 0 height width height dclcol)
(vector_image width height width 0 dclcol)
(vector_image width 0 0 0 dclcol)
(fill_image 0 0 width height dclcol)
(end_image)
)
;;;******************************************
;;;获取cad标准颜色
;;;******************************************
(defun getcolordata(col / ccc)
(setq ccc(acad_colordlg col t))
(if (not ccc)(setq ccc col))
ccc
)
;;;******************************************
;;;初始化颜色图像按钮
;;;******************************************
(defun c_img(key col)
(if col
(progn
(start_image key)
(fill_image 0 0 (dimx_tile key)(dimy_tile key)col)
(end_image)
(set_tile "color" (cond((=(strlen(itoa col))1)(strcat " "(itoa col)))
((=(strlen(itoa col))2)(strcat " "(itoa col)))
((=(strlen(itoa col))3)(strcat ""(itoa col)))
)
)
)
)
)
;;;******************************************
;;;温馨提示
;;;******************************************
(defun wxts()
(alert wxts)
)
;;;******************************************
;;;删除椭圆
;;;******************************************
(defun deleteyuan()
(if (setq elliss(ssget "x" (list(cons 0 "ellipse,circle")(cons 8 "findttz"))))
(repeat (setq n (sslength elliss))
(vla-delete (vlax-ename->vla-object (ssname elliss (setq n(1- n)))))
)
)
)
;;;******************************************
;;;删除椭圆2
;;;******************************************
(defun deleteyuan2()
(deleteyuan)
(vla-ZoomScaled myacad 1 acZoomScaledRelative)
(vla-zoomprevious myacad)
)
;;;******************************************
;;;暗显图元
;;;******************************************
(DEFUN REDRAW4()
(IF FINDLST
(PROGN
(vl-remove-if '(LAMBDA(X)(VLA-HIGHLIGHT X :VLAX-FALSE))(MAPCAR 'CADR FINDLST))
)
)
)
;;;******************************************
;;;添加列表框内列表
;;;******************************************
(defun adlst(key lst);;;仅对popup_list或list_box有效
(start_list key 3);;;处理列表开始
(mapcar 'add_list lst)
(end_list);;;添加列表结束
)
;;;******************************************
;;;滑动条动作函数
;;;******************************************
(defun dohdt ()
(set_tile "jiaoju" $value)
(setq jiaoju $value)
(vl-registry-write "HKEY_CURRENT_USER\\czthoption" "jiaoju" jiaoju)
(gete)
(getetext)
(zoome e)
)
;;;******************************************
;;;滑动条链接焦距编辑框函数
;;;******************************************
(defun linkhdt2jiaoju(/ num)
(setq num (atof $value))
(if(or (< num -10000)(> num 10000))
(progn
(if (< num 0) (alert"\n请大于-10000..."))
(if (> num 10000)(alert"\n请小于10000..."))
(set_tile $key (get_tile "hdt" ))
(setq jiaoju (atof $value))
(vl-registry-write "HKEY_CURRENT_USER\\czthoption" "jiaoju" jiaoju)
)
(progn
(set_tile "hdt" (rtos num 2 1))
(setq jiaoju (rtos num 2 1))
(vl-registry-write "HKEY_CURRENT_USER\\czthoption" "jiaoju" jiaoju)
)
)
)
;;;****************************************************
;;;普通文字画椭圆包围框
;;;*****************************************************
(defun getbox(obj / inserp )
(if (assoc "B" (LIST E))
(PROGN
(SETQ MIDP (NTH 3 E)
minp (NTH 4 E)
MAXP (NTH 5 E)
)
(EMAKECR midp MINP tcol etext)
)
(PROGN
(if(not(vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox(list obj 'minp 'maxp))))
(progn
(setq minp (vlax-safearray->list minp)
maxp (vlax-safearray->list maxp)
midp (polar minp (angle minp maxp) (/ (distance minp maxp) 2))
)
(EMAKEEL midp MINP tcol etext)
)
)
)
)
(VLA-HIGHLIGHT OBJ :VLAX-TRUE)
(REDRAW (ENTLAST) 3)
)
;;;******************************************
;;;聚焦对象
;;;******************************************
(defun zoome(e)
(deleteyuan)
(getetext)
(setq txtang (last e))
(getbox (cadr e))
(setq objlast (VLAX-ENAME->VLA-OBJECT (entlast)))
(if (/= txtang 0.0) (vla-rotate objlast(vlax-3d-point midp)txtang))
(vla-highlight objlast :vlax-true)
(vla-zoomwindow myacad (vlax-3d-point(MAPCAR '(LAMBDA(X Y)(- X Y))minp (list(* (distof jiaoju) 100) (* (distof jiaoju) 100))))
(vlax-3d-point(MAPCAR '(LAMBDA(X Y)(+ X Y))maxp (list(* (distof jiaoju) 100) (* (distof jiaoju) 100)))))
)
;;;******************************************
;;;查找编辑框动作函数
;;;******************************************
(defun do1()
(if(and(/= oldch "输入查找字符串")(not(member oldch czstrlst)))
(progn
(setq czstrlst(cons oldch czstrlst))
(adlst "18" czstrlst)
(set_tile "18" "0")
)
)
)
;;;******************************************
;;;替换编辑框动作函数
;;;******************************************
(defun do2()
(if(and(/= newch "输入替换字符串")(not(member newch thstrlst)))
(progn
(setq thstrlst(cons newch thstrlst))
(adlst "19" thstrlst)
(set_tile "19" "0")
)
)
)
;;;******************************************
;;;选择动作
;;;******************************************
(defun do7()
(sssetfirst nil nil)
(select)
(setq findlst nil sstxt nil )
(getss)
(LIANGXIAN findlst)
(xsdhk)
)
;;;******************************************
;;;设置选择范围状态值（显示值）
;;;******************************************
(defun do8()
(setq findlst nil sstxt nil )
(getfw)
(getss)
(LIANGXIAN findlst)
(xsdhk)
)
;;;******************************************
;;;列表框动作程序
;;;******************************************
(defun do91()
;;; (setq e(nth (atoi drcznr)findlst))
(gete)
(if e
(progn
(getetext)
(redraw4)
(zoome e)
(setq wxtsstr (strcat (itoa(1+(atoi drcznr))) "\/" (itoa (length findlst))" 当前文本:" etext))
(set_tile "wxts" wxtsstr)
(if (= tongtihuan "0")
(progn
(set_tile "onerow" etext)
(setq onerow etext)
)
)
)
)
)
(defun do9()
(gete)
(LIANGXIAN (list e))
(redraw4)
(zoome e)
(princ"\n任意键返回对话框!!!")
(while (and
(/= 2 (setq a(car (grread))))
(/= a 3)
(/= a 11)
(/= a 25)
)
)
(vla-delete (vlax-ename->vla-object(entlast)))
(xsdhk)
)
;;;******************************************
;;;上一个缩放和下一个缩放
;;;******************************************
(defun do10(/ )
(deleteyuan)
(cond
((=(type drcznr) 'str)
(if (= up "1")(setq drcznr(itoa(1-(atoi drcznr))))(setq drcznr(itoa(1+(atoi drcznr)))))
)
((=(type drcznr) 'int)
(if (= up "1")(setq drcznr(itoa(1- drcznr)))(setq drcznr(itoa(1+ drcznr))))
)
)
(setq endnum(length findlst))
(cond
((and(<(atoi drcznr)0)(= up "1"))
(setq drcznr (itoa (1- endnum)))
)
((and(>=(atoi drcznr)endnum)(= down "1"))
(setq drcznr "0")
)
)
(set_tile "9" drcznr)
(if (and findlst (gete))
(progn
(getetext)
(zoome e)
(setq wxtsstr (strcat (itoa(1+(atoi drcznr))) "\/" (itoa (length findlst))" 当前文本:" etext))
(set_tile "wxts" wxtsstr)
(if (= tongtihuan "0")
(progn
(set_tile "onerow" etext)
(setq onerow etext)
)
)
)
)
)
;;;******************************************
;;;移除列表框内列表项
;;;******************************************
(defun do15(/ )
(setq endnum(length findlst))
(if (and findlst (> endnum 0)(<(atoi drcznr) endnum))
(progn
(setq findlst (vl-remove (setq e(nth (atoi drcznr) findlst))findlst))
(getetext)
(if findlst
(progn
(setq j 0)
(setq findlst(mapcar '(lambda(x)(setq j(1+ j))
(setq ex(substr (caddr x) (+ 2(vl-string-search " " (caddr x)))))
(append (list(car x)(cadr x)(strcat "["(itoa j)"] "ex))(cdddr x)))
findlst)
)
)
)
(adlst "9" (mapcar 'caddr findlst))
(setq endnum(length findlst))
(cond
((>(atoi drcznr)0)
(setq drcznr (itoa (- (atoi drcznr) 1)))
)
)
(set_tile "9" drcznr)
(if findlst
(if(= (atoi drcznr)endnum)
(setq wxtsstr (strcat drcznr "\/" (itoa (length findlst))" 移除文本:" etext))
(setq wxtsstr (strcat (itoa(1+ (atoi drcznr))) "\/" (itoa (length findlst))" 移除文本:" etext))
)
(progn
(setq wxtsstr (strcat drcznr "\/" (itoa (length findlst))" 移除文本:" etext))
(MODE_TILE "3" 1)
(MODE_TILE "4" 1)
(MODE_TILE "10" 1)
(MODE_TILE "11" 1)
(MODE_TILE "12" 1)
(MODE_TILE "15" 1)
(MODE_TILE "hdt" 1)
(MODE_TILE "xiugai" 1)
)
)
(set_tile "wxts" wxtsstr)
)
)
)
;;;****************************************************
;;;查找历史记录列表框动作
;;;*****************************************************
(defun do18()
(setq oldch (nth (atoi $value) czstrlst))
(set_tile "oldword" oldch)
)
;;;****************************************************
;;;替换历史记录列表框动作
;;;*****************************************************
(defun do19()
(setq newch (nth (atoi $value) thstrlst))
(set_tile "newword" newch)
)
;;;****************************************************
;;;画椭圆
;;;*****************************************************
(DEFUN EMAKEEL(p11 p10 col txt)
(entmake (list '(0 . "ELLIPSE") '(100 . "AcDbEntity")'(100 . "AcDbEllipse")(cons 10 p11)
(cons 11 (list (* 1.3 (eval(cons 'max (list(- (car p11)(car p10))(- (cadr p11)(cadr p10))))))0.0 0.0))(cons 8 "findttz")(cons 62 col)
(cons 40 (/ 1 (* 0.45(if (>(strlen txt)4)(strlen txt)4))))'(41 . 0)'(42 . 6.28319)
)
)
)
;;;****************************************************
;;;画圆
;;;*****************************************************
(DEFUN EMAKECR(p11 p10 col txt)
(entmake (list '(0 . "CIRCLE") '(100 . "AcDbEntity")(cons 10 p11)
(cons 40 (eval(cons 'max (list(- (car p11)(car p10))(- (cadr p11)(cadr p10))))))(cons 8 "findttz")(cons 62 col)
)
)
)
;;;******************************************
;;;整行修改
;;;******************************************
(defun xiugai()
(if findlst
(progn
(gete)
(setq obj (cadr e))
(setq textqz(substr (caddr e) 1 (1+ (setq j(vl-string-search " " (caddr e))))))
(getetext)
(zoome e)
(if (assoc "B" (list e))
(progn
(divss findlst)
(repeat (setq knum(length kuaitext))
(if (not(member (setq blkname(vla-get-name(car(nth (setq knum(1- knum))kuaitext))))blklst))
(setq blklst(cons blkname blklst))
)
)
(vlax-for blk (vla-get-blocks(setq mydoc(vla-get-activedocument(vlax-get-acad-object))))
(if (member (setq blkname(vla-get-name blk))blklst)
(progn
(SETQ NN 0)
(repeat (vla-get-count blk)
(if(and(or(= "AcDbText" (vla-get-objectname (setq oldobj(vla-item blk NN))))
(= "AcDbMText" (vla-get-objectname (setq oldobj(vla-item blk NN))))
)
)
(progn
(if (and(=(car(nth (atoi drcznr)findlst))"B")(= blkname (vla-get-name(cadr(nth (atoi drcznr)findlst)))))
(progn
(setq thknum 0)
(vla-put-textstring oldobj onerow)
(vla-update oldobj)
(setq thknum(sslength(SETQ BLKSS(ssget "X"(list (cons 0 "insert")(cons 2 blkname))))) MM 0)
(REPEAT thknum
(vla-update (VLAX-ENAME->VLA-OBJECT(SSNAME BLKSS MM)))
(SETQ MM(1+ MM))
)
(MAPCAR '(LAMBDA(x)
(if (and (= (car x) "B")(= (vla-get-name (cadr x)) blkname))
(progn
(setq findlst (subst (list "B" (NTH 1 x) (strcat textqz ONEROW) (NTH 3 x)(NTH 4 x)(NTH 5 x)) x findlst))
(setq thknum (1+ thknum))
)
)
)
findlst
)
(adlst "9" (mapcar 'caDdr findlst))
(setq wxtsstr (strcat "块名:" blkname "文本"etext"改为"onerow"..." "共更新块参照" (itoa thknum)"个"))
(set_tile "wxts" wxtsstr)
)
)
)
)
(setq nn(1+ nn))
)
)
)
)
)
(progn
(vla-put-textstring obj onerow)
(vla-update obj);;;更新查找的字符串
(setq findlst (subst (append (list (car e)obj (strcat textqz onerow)) (cdddr e))e findlst))
(adlst "9" (mapcar 'caddr findlst));;;更新查找结果列表
(set_tile "9" (setq drcznr(itoa(if(<(1+(atoi drcznr))(length findlst))(1+(atoi drcznr)) 0))))
(setq wxtsstr (strcat etext "已经修改为" onerow))
)
)
(set_tile "wxts" wxtsstr)
(if (= tongtihuan "0")
(progn
(gete)
(set_tile "onerow" (getetext))
(setq onerow etext)
)
)
)
)
)
;;;*********************************************
;;;范围选择
;;;*********************************************
(defun select()
(if(= wqpp "1")(setq ppzfc oldch)(setq ppzfc (strcat "*" oldch "*")))
(setq js1 0 js2 0 js3 0)
(PROMPT"\n选择查找替换范围:")
(setvar 'nomutt 1)
(if (or (= sxwz "1")(= knwz "1"))
(setq ss (ssget (list '(-4 . "<or")(cons 0 "INSERT")
'(-4 . "<and")(cons 0 "TEXT,MTEXT,TCH_*TEXT,TCH_DRAWINGNAME")
'(-4 . "<or")(cons 1 ppzfc)(cons 1 (strcase ppzfc))'(-4 . "or>")
'(-4 . "and>")
'(-4 . "or>"))))
(setq ss (ssget (list (cons 0 "TEXT,MTEXT,TCH_*TEXT,TCH_DRAWINGNAME")'(-4 . "<or")(cons 1 ppzfc)(cons 1 (strcase ppzfc))'(-4 . "or>"))))
)
(setq oldss ss)
)
;;;******************************************
;;;取得全部选择范围状态下选择集
;;;******************************************
(defun getfw()
(if(= wqpp "1")(setq ppzfc oldch)(setq ppzfc (strcat "*" oldch "*")))
(if (= re 8)
(progn
(if(or (= sxwz "1")(= knwz "1"))
(setq ss (ssget "X"(list '(-4 . "<or")(cons 0 "INSERT")
'(-4 . "<and")(cons 0 "TEXT,MTEXT,TCH_*TEXT,TCH_DRAWINGNAME")
'(-4 . "<or")(cons 1 ppzfc)(cons 1 (strcase ppzfc))'(-4 . "or>")
'(-4 . "and>")
'(-4 . "or>")))
)
(setq ss (ssget "X"(list
(cons 0 "TEXT,MTEXT,TCH_*TEXT,TCH_DRAWINGNAME")
'(-4 . "<or")(cons 1 ppzfc)(cons 1 (strcase ppzfc))'(-4 . "or>"))
)
)
)
(setq oldss ss)
)
(setq ss oldss)
)
)
;;;****************************************************
;;;;;;组成新字符串
;;;*****************************************************
(defun getnewtext(etext)
(setq pos(vl-string-search (if (= qfdxx "0")(strcase oldch)oldch)
(if (= qfdxx "0")(strcase etext)etext))
)
(if pos
(setq newtext(strcat (substr etext 1 pos)newch(substr etext (+ 1 pos (strlen oldch)))))
(setq newtext etext)
)
)
;;;****************************************************
;;;;;;变换矩阵
;;;****************************************************
(defun M_REV (A / N U V)
(setq N 0)
(repeat (length A)
(setq U (cons (mapcar '(lambda (V) (nth N V)) A) U)
N (1+ N)
)
)
(reverse U)
)
;;;***********************************************************
;;; 获取块内非块实体
;;;***********************************************************
(defun ayGetAllEntInBLK(entBlkName / xBlkName xBlkDef entName1 entType tmx xinserp minp maxp midp )
(SETQ xinserp(cdr (assoc 10 (entget entBlkName))));;;嵌套块插入点
(SETQ xBlkName(cdr (assoc 2 (entget entBlkName))));;;嵌套块名
(SETQ oldobj(vlax-ename->vla-object entBlkName));;;嵌套块vla对象
(setq kuaiang(cdr (assoc 50 (entget entBlkName))));;;块的旋转角度
(setq xBlkDef (tblobjname "Block" xBlkName))
(if (equal xinserp oldinserp)
(setq tmx oldinserp)
(progn
(setq tmx (mapcar '(lambda(x y)(+ x y))oldinserp xinserp))
(setq oldinserp tmx)
)
)
(while (setq entName1 (entnext xBlkDef))
(setq entType (cdr (assoc 0 (entget entName1))));;;子图元类型
(SETQ xoldobj(vlax-ename->vla-object entName1));;;子图元vla对象
(if(= entType "INSERT")
(progn
(ayGetAllEntInBLK entName1);;;递归
(grtext -2 (strcat "正在搜索块内文字,请耐心等候" (nth biaojinum biaoji)))
(if (< biaojinum 8)(setq biaojinum (1+ biaojinum))(setq biaojinum 0))
)
(IF (AND(OR(= "AcDbText" (vla-get-objectname xoldobj))
(= "AcDbMText" (vla-get-objectname xoldobj))
(= "AcDbAttributeDefinition" (vla-get-objectname xoldobj))
(= "AcDbAttribute" (vla-get-objectname xoldobj))
)
(setq etext(vla-get-textstring xoldobj))
(wcmatch (if (= qfdxx "0") (strcase etext )etext)(if (= qfdxx "0")(strcase ppzfc )ppzfc))
)
(PROGN
(if(not(vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox(list xoldobj 'minp 'maxp))))
(progn
(setq minp (vlax-safearray->list minp)
maxp (vlax-safearray->list maxp)
midp (polar minp(angle minp maxp) (/(distance minp maxp)2))
)
(setq minp(mapcar '(lambda(x y)(+ x y))TMX minp));;转换(WCS)
(setq mAXp(mapcar '(lambda(x y)(+ x y))TMX mAXp))
(setq midp (mapcar '(lambda(x y)(+ x y))TMX midp));;转换(WCS)
(setq txtang(+ kuaiang (cdr (assoc 50 (entget entBlkName)))));;;块的旋转角度+块内文字旋转角度
(setq FINDLST (cons (list "B" oldobj etext midp minp MAXP txtang) FINDLST))
(grtext -2 (strcat "正在搜索块内文字,请耐心等候" (nth biaojinum biaoji)))
(if (< biaojinum 8)(setq biaojinum (1+ biaojinum))(setq biaojinum 0))
(setq js2(1+ js2))
)
)
)
)
)
(setq xBlkDef entName1)
)
(SETQ oldinserp (cdr (assoc 10 (entget oldkent))))
)
;;;***************************************************
;;;获取各类型文字选择集
;;;***************************************************
(defun getss(/ strtype sslst blklst attlst)
(if(= wqpp "1")(setq ppzfc oldch)(setq ppzfc (strcat "*" oldch "*")))
(setq vartxtlst (list "ssINSERT" "sstext" "ssmtext" "ssTCH_*TEXT" "ssTCH_DRAWINGNAME")
filterlst (list "INSERT" "TEXT" "MTEXT" "TCH_*TEXT" "TCH_DRAWINGNAME")
)
(if ss;;;如果没有选择到，则所有选择集复位
(ssgflt ss vartxtlst filterlst)
(setq ssINSERT nil sstext nil ssmtext nil ssTCH_*TEXT nil ssTCH_DRAWINGNAME nil)
)
;;;1、普通文字查找
(IF (= dhwz "0")(SETQ sstext NIL))
(IF (= dUOhwz "0")(SETQ ssMtext NIL))
(IF (= tzwz "0") (SETQ ssTCH_*TEXT NIL))
(IF (= tzqt "0") (SETQ ssTCH_DRAWINGNAME NIL))
(setq sslst (vl-remove nil(list sstext ssmtext ssTCH_*TEXT ssTCH_DRAWINGNAME)))
(repeat (setq h (length sslst))
(command "select"
(if sstxt
sstxt
(setq sstxt (ssadd))
)
(nth (setq h (1- h)) sslst)
""
)
(setq sstxt
(ssget "p"
(list (cons 0 "TEXT,MTEXT,TCH_*TEXT,TCH_DRAWINGNAME"))
)
);;;若不过滤，则文字和线等成组时会连线一起选，出错
(if sstxt
(progn
(setq js3 0
newsstxt (ssadd)
)
(repeat (setq ct0 (sslength sstxt))
(setq ob (vlax-ename->vla-object
(setq en1 (ssname sstxt (setq ct0 (1- ct0))))
)
edata (entget en1)
txtang (cdr (assoc 50 edata))
etext (cdr (assoc 1 edata))
entype (cdr (assoc 0 edata))
)
(if (or (wcmatch (if (= qfdxx "0")
(strcase etext)
etext
)
(if (= qfdxx "0")
(strcase ppzfc)
ppzfc
)
)
(wcmatch (if (= qfdxx "0")
(strcase etext)
etext
)
(if (= qfdxx "0")
(strcase oldch)
oldch
)
)
(= (if (= qfdxx "0")
(strcase etext)
etext
)
(if (= qfdxx "0")
(strcase ppzfc)
ppzfc
)
)
(= (if (= qfdxx "0")
(strcase etext)
etext
)
(if (= qfdxx "0")
(strcase oldch)
oldch
)
)
)
(progn
(setq findlst (cons (list "C" ob etext txtang) findlst))
(setq js3 (1+ js3))
)
)
)
)
)
)
;;;3、块内文字匹配查找
(if (= knwz "1")
(progn
(if ssINSERT
(COMMAND "SELECT" ssINSERT "")
)
(setq ssknwz (ssget "P" (list (cons 0 "INSERT")(cons 66 0)))
JS2 0
)
(if ssknwz
(progn
(setq stime(getvar"date"))
(setq biaoji '("|" "||" "|||" "|||||" "||||||" "|||||||" "||||||||" "|||||||||" "||||||||||" ) biaojinum 0)
(grtext -2 (strcat "正在搜索块内文字,请耐心等候" (nth biaojinum biaoji)))
(repeat (SETQ N (sslength ssknwz))
(setq oldkent (SSNAME ssknwz (SETQ N (1- N))))(vlax-ename->vla-object oldkent)
(SETQ oldinserp (cdr (assoc 10 (entget oldkent))))
(ayGetAllEntInBLK oldkent)
)
(setq etime(getvar"date"))
(grtext -2 (strcat"搜索块内文字完成，耗时"(rtos(* 86400.0 (- (- etime stime) (fix (- etime stime))))2 2)"秒..."))
)
)
)
)
;;;2、属性文字匹配查找
(if (= sxwz "1")
(progn
(if ssINSERT
(COMMAND "SELECT" ssINSERT "")
)
(setq sssxwz (ssget "P" (list (cons 0 "INSERT") (cons 66 1)))
JS1 0
)
(if sssxwz
(repeat (setq n (sslength sssxwz))
(if (setq vlae (vlax-ename->vla-object
(ssname sssxwz (setq n (1- n)))
)
)
(progn
(setq attlst
(vlax-safearray->list
(vlax-variant-value (vla-GETATTRIBUTES vlae))
)
)
(repeat (setq m (length attlst))
(setq etext
(vlax-get-property
(setq attobj (nth (setq m (1- m)) attlst))
'textstring
)
)
(setq txtang(vla-get-rotation attobj))
(if (wcmatch (if (= qfdxx "0")
(strcase etext)
etext
)
(if (= qfdxx "0")
(strcase ppzfc)
ppzfc
)
)
(PROGN
(setq findlst
(cons (list "A" attobj etext txtang) findlst)
)
(SETQ JS1 (1+ JS1))
)
)
)
)
)
)
)
)
)
(if findlst (setq findlst (vl-sort findlst '(lambda(x y)(<(caddr x)(caddr y))))))
(if findlst (progn (setq j 0)(setq findlst(mapcar '(lambda(x)(setq j(1+ j))(append (list(car x)(cadr x)(strcat "["(itoa j)"] "(caddr x)))(cdddr x)))findlst))))
(zhuangtai)
)
;;;****************************************************
;;;将各类型文字列表分类
;;;****************************************************
(defun divss(lst)
(if lst
(foreach x lst
(COND((SETQ GTXT(assoc "C"(list x)))
(setq PUTONGTEXT (CONS (CdR GTXT) PUTONGTEXT))
)
((SETQ GTXT(assoc "B" (list x)))
(setq KUAITEXT (CONS (CDR GTXT) KUAITEXT))
)
((SETQ GTXT(assoc "A" (list x)))
(setq SHUXINGTEXT (CONS (CdR GTXT) SHUXINGTEXT))
)
)
)
)
(setq PUTONGTEXT(reverse PUTONGTEXT)KUAITEXT(reverse KUAITEXT)SHUXINGTEXT(reverse SHUXINGTEXT))
)
;;;****************************************************
;;;替换子程序
;;;*****************************************************
(defun tihuan (lst)
(divss lst)
(SETQ JS1 (LENGTH putongtext) JS2 (LENGTH shuxingtext) JS3 (LENGTH kuaitext))
(if putongtext
(repeat (setq n
(cond
((= re 3)
(length PUTONGTEXT)
)
((= replace "1")
1
)
)
)
(cond ((= re 3)
(setq pte (nth (setq n(1- n)) PUTONGTEXT))
(setq ob (car pte)
textqz(strcat "[" (ITOA(1+(vl-position (cons "C" pte) findlst)))"] ")
etext(VLA-GET-TEXTSTRING OB)
txtang(last pte)
)
(GETBOX ob)
(setq elle(entlast))
(if (/= txtang 0.0) (vla-rotate (VLAX-ENAME->VLA-OBJECT elle)(vlax-3d-point midp)txtang))
)
((= replace "1")
(setq ob (car(setq pte(cdr(setq e(nth (atoi drcznr) findlst))))))
(if ob
(progn
(setq textqz(strcat "[" (ITOA(1+(vl-position (cons "C" pte) findlst)))"] ")
etext (VLA-GET-TEXTSTRING OB)
)
(zoome e)
)
)
)
)
(if ob
(progn
(setq entype (cdr(assoc 0(entget(vlax-vla-object->ename ob)))))
(setq newtext(getnewtext etext))
(cond((AND(= entype "TEXT")(= dhwz "1"))
(vlax-put-property ob 'TextString newtext)
)
((AND(= entype "TCH_MTEXT")(= tzwz "1"))
(entmod (subst (cons 1 newtext) (assoc 1 edata) edata))
)
((AND(= entype "MTEXT")(= duohwz "1"))
(vlax-put-property ob 'TextString newtext)
)
((AND(= entype "TCH_TEXT")(= tzwz "1"))
(vlax-put-property ob 'Text newtext)
)
((AND(= entype "TCH_DRAWINGNAME")(= tzqt "1"))
(vlax-put-property ob 'NameText newtext)
)
)
(vla-update ob )
(setq findlst (subst (list "C" ob (strcat textqz newtext) txtang)(list "C" ob (cadr pte) txtang)findlst))
(adlst "9" (mapcar 'caDdr findlst))
(setq wxtsstr (strcat (itoa(1+(atoi drcznr))) "\/" (itoa (length findlst))" 当前为普通文本:" etext "改为" newtext))
(set_tile "wxts" wxtsstr)
)
)
)
)
(if shuxingtext
(MAPCAR '(LAMBDA (x)
(if (assoc(CaR x)shuxingtext)
(progn
(setq etext (vla-get-textstring (car x))
textqz(strcat "[" (ITOA(1+(vl-position (cons "A" x) findlst)))"] ")
)
(setq txtang (last x))
(vla-put-textstring (car x) (setq newtext(getnewtext etext)))
(vla-update (car x))
(getbox (car x))
(if (/= txtang 0.0) (vla-rotate (VLAX-ENAME->VLA-OBJECT (entlast))(vlax-3d-point midp)txtang))
(if (/= re 3)
(vla-zoomwindow myacad (vlax-3d-point(MAPCAR '(LAMBDA(X Y)(- X Y))minp (list(* (distof jiaoju) 100) (* (distof jiaoju) 100))))
(vlax-3d-point(MAPCAR '(LAMBDA(X Y)(+ X Y))maxp (list(* (distof jiaoju) 100) (* (distof jiaoju) 100)))))
)
(setq findlst (subst (list "A" (car x) (strcat textqz newtext) (last x))(list "A" (car x) (cadr x) (last x))findlst))
(adlst "9" (mapcar 'caDdr findlst))
(setq wxtsstr (strcat (itoa(1+(atoi drcznr))) "\/" (itoa (length findlst))" 当前为块属性文本:" etext"改为"newtext))
(set_tile "wxts" wxtsstr)
)
)
)
(cond ((= re 3)
shuxingtext
)
((= replace "1")
(list(cdr(nth (atoi drcznr) findlst)))
)
)
)
)
(if kuaitext
(progn
(repeat (setq knum(length kuaitext))
(if (not(member (setq blkname(vla-get-name(car(nth (setq knum(1- knum))kuaitext))))blklst))
(setq blklst(cons blkname blklst))
)
)
(vlax-for blk (vla-get-blocks(setq mydoc(vla-get-activedocument(vlax-get-acad-object))))
(if (member (setq blkname(vla-get-name blk))blklst)
(progn
(SETQ NN 0)
(repeat (vla-get-count blk)
(if(and(or(= "AcDbText" (vla-get-objectname (setq oldobj(vla-item blk NN))))
(= "AcDbMText" (vla-get-objectname (setq oldobj(vla-item blk NN))))
)
(setq etext(vla-get-textstring oldobj))
(wcmatch (if (= qfdxx "0") (strcase etext )etext)(if (= qfdxx "0")(strcase ppzfc )ppzfc))
)
(progn
(if (or (= re 3)(and(= replace "1")(=(car(nth (atoi drcznr)findlst))"B")(= blkname (vla-get-name(cadr(nth (atoi drcznr)findlst))))))
(progn
(setq thknum 0)
(vla-put-textstring oldobj (setq newtext(getnewtext etext)))
(vla-update oldobj)
(SETQ BLKSS(ssget "X"(list (cons 0 "insert")(cons 2 blkname))))
(if BLKSS
(progn
(setq thknum(sslength BLKSS) MM 0)
(REPEAT thknum
(vla-update (SETQ OB(VLAX-ENAME->VLA-OBJECT(SSNAME BLKSS MM))))
(GETBOX OB)
(SETQ MM(1+ MM))
)
)
)
(MAPCAR '(LAMBDA(x)
(if (and (= (car x) "B")(= (vla-get-name (cadr x)) blkname))
(progn
(SETQ textqz(strcat "[" (ITOA(1+(vl-position x findlst)))"] "))
(setq findlst(subst (list "B" (NTH 1 x) (strcat textqz newtext) (NTH 3 x)(NTH 4 x)(NTH 5 x)) x findlst))
(setq thknum (1+ thknum))
)
)
)
findlst
)
(adlst "9" (mapcar 'caDdr findlst))
(setq wxtsstr (strcat "块名:" blkname "文本"etext"改为"newtext"..." "共更新块参照" (itoa thknum)"个"))
(set_tile "wxts" wxtsstr)
)
)
)
)
(setq nn(1+ nn))
)
)
)
)
)
)
(cond
((=(type drcznr) 'str)
(if (= up "1")(setq drcznr(itoa(1-(atoi drcznr))))(setq drcznr(itoa(1+(atoi drcznr)))))
)
((=(type drcznr) 'int)
(if (= up "1")(setq drcznr(itoa(1- drcznr)))(setq drcznr(itoa(1+ drcznr))))
)
)
(setq endnum(length findlst))
(cond
((and(<(atoi drcznr)0)(= up "1"))
(setq drcznr (itoa (1- endnum)))
)
((and(>=(atoi drcznr)endnum)(= down "1"))
(setq drcznr "0")
)
)
(set_tile "9" drcznr)
(if (/= replace "1")(jieguotishi))
(setq putongtext nil shuxingtext nil kuaitext nil)
);_ END tihuan
;;;********************************************************
;;;;;;全部亮显:普通文字亮显，块参照文字画椭圆亮显
;;;********************************************************
(DEFUN LIANGXIAN( lst / )
(SETQ PTLSS(SSADD) SXLSS(SSADD)kLSS(SSADD))
(IF (= RE 4)
(PROGN
(divss lst)
(IF PUTONGTEXT
(PROGN
(MAPCAR '(LAMBDA(X)(SSADD (VLAX-VLA-OBJECT->ENAME X) PTLSS))(MAPCAR 'CAR PUTONGTEXT))
)
)
(IF SHUXINGTEXT
(PROGN
(MAPCAR '(LAMBDA(X)(SSADD (VLAX-VLA-OBJECT->ENAME X) SXLSS))(MAPCAR 'CAR SHUXINGTEXT))
)
)
(IF KUAITEXT
(progn
(MAPCAR '(LAMBDA(X)
(SETQ TXT (nth 1 x)
midp(nth 2 x)
inserp(nth 3 x)
txtang(nth 4 x)
)
(EMAKEEL midp inserp tcol txt)
(if (/= txtang 0.0) (vla-rotate (VLAX-ENAME->VLA-OBJECT (entlast))(vlax-3d-point midp)txtang))
)
KUAITEXT
)
(setq elliss(ssget "x" (list(cons 0 "ellipse")(cons 8 "findttz"))))
)
)
(cond
((and PTLSS SXLSS elliSS)(command "select" PTLSS SXLSS elliSS "")(sssetfirst nil (ssget"p")))
( PTLSS (sssetfirst nil PTLSS))
( SXLSS(sssetfirst nil SXLSS))
( elliSS(sssetfirst nil elliSS))
)
)
)
(if (/= replace "1")(jieguotishi))
(setq putongtext nil shuxingtext nil kuaitext nil)
)
;;;**************************************************
;;;;;;查找替换结果提示
;;;**************************************************
(defun jieguotishi()
(COND
((= RE 3)
(if (>(+ (if (and(= sxwz "1")js1) js1 0) (if (and(= knwz "1")js2) js2 0)(if (and (or (= dhwz "1")(= duohwz "1")(= tzwz "1")(= tzqt "1"))js3) js3 0))0)
(progn
(setq wxtsstr (strcat "共替换了" (itoa (+ (if js1 js1 0) (if js2 js2 0)(if js3 js3 0)))"个文本..."
(if (and (or (= dhwz "1")(= duohwz "1")(= tzwz "1")(= tzqt "1"))js3(> js3 0)) (strcat"普通文本:" (itoa js3) "个...")"")
(if (and(= sxwz "1")js1(> js1 0)) (strcat "属性文本:" (itoa js1) "个...")"")
(if (and(= knwz "1")js2(> js2 0)) (strcat "块参照文本:" (itoa js2) "个...")"")
)
)
(set_tile "wxts" wxtsstr)
(princ (strcat "\n"wxtsstr))
)
(progn
(IF FINDLST
(setq wxtsstr(strcat "共替换了" (itoa (LENGTH FINDLST)) " 个文本..."))
(if (AND(NOT FINDLST)(= (+ (if js1 js1 0) (if js2 js2 0) (if js3 js3 0)) 0))(setq wxtsstr(strcat "未找到符合要求的包含 " oldch " 的文本...")))
)
(set_tile "wxts" wxtsstr)
(princ (strcat "\n"wxtsstr))
)
)
)
((or(= RE 4)(= RE 8))
(if (>(+ (if (and(= sxwz "1")js1) js1 0) (if (and(= knwz "1")js2) js2 0)(if (and (or (= dhwz "1")(= duohwz "1")(= tzwz "1")(= tzqt "1"))js3) js3 0))0)
(progn
(setq wxtsstr (strcat "共找到了" (itoa (+ (if js1 js1 0) (if js2 js2 0)(if js3 js3 0)))"个文本..."
(if (and (or (= dhwz "1")(= duohwz "1")(= tzwz "1")(= tzqt "1"))js3(> js3 0)) (strcat"普通文本:" (itoa js3) "个...")"")
(if (and(= sxwz "1")js1(> js1 0)) (strcat "属性文本:" (itoa js1) "个...")"")
(if (and(= knwz "1")js2(> js2 0)) (strcat "块参照文本:" (itoa js2) "个...")"")
)
)
(set_tile "wxts" wxtsstr)
(princ (strcat "\n"wxtsstr))
)
(progn
(IF FINDLST
(setq wxtsstr(strcat "共找到了" (itoa (LENGTH FINDLST)) " 个文本..."))
(if (AND(NOT FINDLST)(= (+ (if js1 js1 0) (if js2 js2 0) (if js3 js3 0)) 0))(setq wxtsstr(strcat "未找到符合要求的包含 " oldch " 的文本...")))
)
(set_tile "wxts" wxtsstr)
(princ (strcat "\n"wxtsstr))
)
)
)
((= RE 7)
(IF FINDLST
(setq wxtsstr(strcat "共找到了" (itoa (LENGTH FINDLST)) " 个文本..."))
(if (AND(NOT FINDLST)(= (+ (if js1 js1 0) (if js2 js2 0) (if js3 js3 0)) 0))(setq wxtsstr(strcat "未找到符合要求的包含 " oldch " 的文本...")))
)
(set_tile "wxts" wxtsstr)
(princ (strcat "\n"wxtsstr))
)
)
)
;;;******************************************
;;;帮助信息
;;;******************************************
(defun helpmsg()
(ALERT "文本查找替换 BY YJR111 2012-10-10
\n 1、可支持通配符；
\n 2、双击查找结果中的文字可以zoom该文字；
\n 3、单击定位查找结果中的文字，可以在替换栏内自由输入替换内容进行替换；
\n 4、上一个和下一个可以不停进行定位搜索；
\n 5、查找结果中定位一个文字后，若替换内容相同，可不停按替换按钮进行相同替换；
\n 6、定位时画椭圆做标记，自动删除；
\n 7、块文字在全部亮显时是亮显椭圆标记，可以用删圆命令删除；
\n 8、单个替换后结果框内实时显示替换结果，并可双击查看；
\n 9、圆的颜色可以更改；
\n 10、焦距可调节文字缩放效果，数值=0为最大放大居中；
\n 11、除非必要，选项中块文字最好不选，否则影响速度；
\n 12、块内文字圆标识，其他文字（包括属性）椭圆标识;
\n 13、其他请自行测试，如有bug，请QQ告知：16570954."
)
)
;;;*************************************************
;支持cad单行和多行文字、TZ单行和多行文字
;查找的文字串可以使用*、？、#等特殊符号，但如果文本中本就存在此特殊符号时可能出错，主要wcmatch函数匹配特殊符号
(defun c:WFF()(c:findttz)(princ))
(vl-load-com)
(defun c:findttz (/ fn x dclid lin return# sstxt
ssl ct0 ct edata etext txtln subln schct ss
DCL_ID newtext en1 ob entype a OLDSSTXT oldss
wqpp dhwz duohwz sxwz tzwz tzqt lightss js1 js2 vartxtlst filterlst
ppzfc newsstxt re entNameList PUTONGTEXT kuaitext shuxingtext
wxtsstr ssINSERT sstext ssmtext ssTCH_*TEXT ssTCH_DRAWINGNAME
onerow replace JS1 JS2 JS3 jiaoju elliss screenpt n nn mm m j k e
etext pte rv1
)
;;;****************************************************************************
;;;出错处理
;;;****************************************************************************
(defun *error* (msg)
(if (wcmatch (strcase msg t) "*break,*cancel*,*exit*,*取消*")
(princ "\n程序退出...")
(princ (strcat "\n" msg))
)
(SETQ FINDLST NIL SS NIL )
(princ)
)
;;;****************************************************************************
;;;初始化条件
;;;****************************************************************************
(setvar "cmdecho" 0)
(vla-startUndoMark (setq mydoc(vla-get-activedocument(setq myacad(vlax-get-acad-object)))))
(if(not(tblsearch "layer" "findttz"))
(vla-add (vla-get-layers mydoc) "findttz")
)
(if (= qk "1")(setq findlst nil))
(xsdhk)
(vla-endUndoMark mydoc)
(setvar 'nomutt 0)
(setvar "cmdecho" 1)
(princ)
) ;_ END defun
;; Silent load.
(princ "*************显示所有命令快捷键:AAA***************")
(princ)
;;====================================================================================================================================
; Next available MSG number is 104
; MODULE_ID ACAD2024doc_LSP_
;;; ACAD2023DOC.LSP Version 1.0 for AutoCAD 2024
;;;
;;; Copyright 2023 Autodesk, Inc. All rights reserved.
;;;
;;; Use of this software is subject to the terms of the Autodesk license
;;; agreement provided at the time of installation or download, or which
;;; otherwise accompanies this software in either electronic or hard copy form.
;;;
;;;
;;;
;;; Note:
;;; This file is loaded automatically by AutoCAD every time
;;; a drawing is opened. It establishes an autoloader and
;;; other utility functions.
;;;
;;; Globalization Note:
;;; We do not support autoloading applications by the native
;;; language command call (e.g. with the leading underscore
;;; mechanism.)
;;;===== Raster Image Support for Clipboard Paste Special =====
;;
;; IMAGEFILE
;;
;; Allow the IMAGE command to accept an image file name without
;; presenting the file dialog, even if filedia is on.
;; Example: (imagefile "c:/images/house.bmp")
;;
(defun imagefile (filename / filedia-save cmdecho-save)
(setq filedia-save (getvar "FILEDIA"))
(setq cmdecho-save (getvar "CMDECHO"))
(setvar "FILEDIA" 0)
(setvar "CMDECHO" 0)
(command "_.-image" "_attach" filename)
(setvar "FILEDIA" filedia-save)
(setvar "CMDECHO" cmdecho-save)
(princ)
)
;;;=== General Utility Functions ===
; R12 compatibility - In R12 (acad_helpdlg) was an externally-defined
; ADS function. Now it's a simple AutoLISP function that calls the
; built-in function (help). It's only purpose is R12 compatibility.
; If you are calling it for anything else, you should almost certainly
; be calling (help) instead.
(defun acad_helpdlg (helpfile topic)
(help helpfile topic)
)
(defun *merr* (msg)
(setq *error* m:err m:err nil)
(princ)
)
(defun *merrmsg* (msg)
(princ msg)
(setq *error* m:err m:err nil)
(princ)
)
;; Loads the indicated ARX app if it isn't already loaded
;; returns nil if no load was necessary, else returns the
;; app name if a load occurred.
(defun verify_arxapp_loaded (app)
(if (not (loadedp app (arx)))
(arxload app f)
)
)
;; determines if a given application is loaded...
;; general purpose: can ostensibly be used for appsets (arx) or (ads) or....
;;
;; app is the filename of the application to check (extension is required)
;; appset is a list of applications, (such as (arx) or (ads)
;;
;; returns T or nil, depending on whether app is present in the appset
;; indicated. Case is ignored in comparison, so "foo.arx" matches "FOO.ARX"
;; Also, if appset contains members that contain paths, app will right-match
;; against these members, so "bar.arx" matches "c:\\path\\bar.arx"; note that
;; "bar.arx" will *not* match "c:\\path\\foobar.arx."
(defun loadedp (app appset)
(cond (appset (or
;; exactly equal? (ignoring case)
(= (strcase (car appset))
(strcase app))
;; right-matching? (ignoring case, but assuming that
;; it's a complete filename (with a backslash before it)
(and
(> (strlen (car appset)) (strlen app))
(= (strcase (substr (car appset)
(- (strlen (car appset))
(strlen app)
)
)
)
(strcase (strcat "\\" app))
)
)
;; no match for this entry in appset, try next one....
(loadedp app (cdr appset)) )))
)
;;; ===== Single-line MText editor =====
(defun LispEd (contents / fname dcl state)
(if (not (setq fname (getvar "program")))
(setq fname "acad")
)
(strcat fname ".dcl")
(setq dcl (load_dialog fname))
(if (not (new_dialog "LispEd" dcl)) (exit))
(set_tile "contents" contents)
(mode_tile "contents" 2)
(action_tile "contents" "(setq contents $value)")
(action_tile "accept" "(done_dialog 1)")
(action_tile "mtexted" "(done_dialog 2)" )
(setq state (start_dialog))
(unload_dialog dcl)
(cond
((= state 1) contents)
((= state 2) -1)
(t 0)
)
)
;;; ===== Discontinued commands =====
(defun c:ddselect(/ cmdecho-save)
(setq cmdecho-save (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(command "._+options" 8)
(setvar "CMDECHO" cmdecho-save)
(princ)
)
(defun c:ddgrips(/ cmdecho-save)
(setq cmdecho-save (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(command "._+options" 8)
(setvar "CMDECHO" cmdecho-save)
(princ)
)
(defun c:gifin ()
(alert "\n不再支持 GIFIN 命令。\n请使用 IMAGE 命令来附着光栅图像文件。\n")
(princ)
)
(defun c:pcxin ()
(alert "\n不再支持 PCXIN 命令。\n请使用 IMAGE 命令来附着光栅图像文件。\n")
(princ)
)
(defun c:tiffin ()
(alert "\n不再支持 TIFFIN 命令。\n请使用 IMAGE 命令来附着光栅图像文件。\n")
(princ)
)
(defun c:ddemodes()
(alert "“对象特性”工具栏包含了 DDEMODES 的功能。\nDDEMODES 已废弃。\n\n欲知详细信息，请从 AutoCAD 帮助的“索引”选项卡中选择“DDEMODES”。")
(princ)
)
(defun c:ddrmodes(/ cmdecho-save)
(setq cmdecho-save (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(command "._+dsettings" 0)
(setvar "CMDECHO" cmdecho-save)
(princ)
)
;;; ===== AutoLoad =====
;;; Check list of loaded <apptype> applications ("ads" or "arx")
;;; for the name of a certain appplication <appname>.
;;; Returns T if <appname> is loaded.
(defun ai_AppLoaded (appname apptype)
(apply 'or
(mapcar
'(lambda (j)
(wcmatch
(strcase j T)
(strcase (strcat "*" appname "*") T)
)
)
(eval (list (read apptype)))
)
)
)
;;
;; Native Rx commands cannot be called with the "C:" syntax. They must
;; be called via (command). Therefore they require their own autoload
;; command.
(defun autonativeload (app cmdliste / qapp)
(setq qapp (strcat "\"" app "\""))
(setq initstring "\n正在初始化...")
(mapcar
'(lambda (cmd / nom_cmd native_cmd)
(progn
(setq nom_cmd (strcat "C:" cmd))
(setq native_cmd (strcat "\"_" cmd "\""))
(if (not (eval (read nom_cmd)))
(eval
(read (strcat
"(defun " nom_cmd "()"
"(setq m:err *error* *error* *merrmsg*)"
"(if (ai_ffile " qapp ")"
"(progn (princ initstring)"
"(_autoarxload " qapp ") (command " native_cmd "))"
"(ai_nofile " qapp "))"
"(setq *error* m:err m:err nil))"
))))))
cmdliste)
nil
)
(defun _autoqload (quoi app cmdliste / qapp symnam)
(setq qapp (strcat "\"" app "\""))
(setq initstring "\n正在初始化...")
(mapcar
'(lambda (cmd / nom_cmd)
(progn
(setq nom_cmd (strcat "C:" cmd))
(if (not (eval (read nom_cmd)))
(eval
(read (strcat
"(defun " nom_cmd "( / rtn)"
"(setq m:err *error* *error* *merrmsg*)"
"(if (ai_ffile " qapp ")"
"(progn (princ initstring)"
"(_auto" quoi "load " qapp ") (setq rtn (" nom_cmd ")))"
"(ai_nofile " qapp "))"
"(setq *error* m:err m:err nil)"
"rtn)"
))))))
cmdliste)
nil
)
(defun autoload (app cmdliste)
(_autoqload "" app cmdliste)
)
(defun autoarxload (app cmdliste)
(_autoqload "arx" app cmdliste)
)
(defun autoarxacedload (app cmdliste / qapp symnam)
(setq qapp (strcat "\"" app "\""))
(setq initstring "\n正在初始化...")
(mapcar
'(lambda (cmd / nom_cmd)
(progn
(setq nom_cmd (strcat "C:" cmd))
(if (not (eval (read nom_cmd)))
(eval
(read (strcat
"(defun " nom_cmd "( / oldcmdecho)"
"(setq m:err *error* *error* *merrmsg*)"
"(if (ai_ffile " qapp ")"
"(progn (princ initstring)"
"(_autoarxload " qapp ")"
"(setq oldcmdecho (getvar \"CMDECHO\"))"
"(setvar \"CMDECHO\" 0)"
"(command " "\"_" cmd "\"" ")"
"(setvar \"CMDECHO\" oldcmdecho))"
"(ai_nofile " qapp "))"
"(setq *error* m:err m:err nil)"
"(princ))"
))))))
cmdliste)
nil
)
(defun _autoload (app)
; (princ "Auto:(load ") (princ app) (princ ")") (terpri)
(load app)
)
(defun _autoarxload (app)
; (princ "Auto:(arxload ") (princ app) (princ ")") (terpri)
(arxload app)
)
(defun ai_ffile (app)
(or (findfile (strcat app ".lsp"))
(findfile (strcat app ".exp"))
(findfile (strcat app ".exe"))
(findfile (strcat app ".arx"))
(findfile app)
)
)
(defun ai_nofile (filename)
(princ
(strcat "\n文件 "
filename
"(.lsp/.exe/.arx) 在搜索路径文件夹中未找到。"
)
)
(princ "\n请检查支持文件的安装，然后重试。")
(princ)
)
;;;===== AutoLoad LISP Applications =====
; Set help for those apps with a command line interface
(setfunhelp "c:gotourl" "" "gotourl")
(autoload "edge" '("edge"))
(setfunhelp "C:edge" "" "edge")
(autoload "3darray" '("3darray"))
(setfunhelp "C:3darray" "" "3darray")
(autoload "mvsetup" '("mvsetup"))
(setfunhelp "C:mvsetup" "" "mvsetup")
(autoload "attredef" '("attredef"))
(setfunhelp "C:attredef" "" "attredef")
(autoload "tutorial" '("tutdemo" "tutclear"
"tutdemo"
"tutclear"))
;;;===== AutoArxLoad Arx Applications =====
;;; ===== Double byte character handling functions =====
(defun is_lead_byte(code)
(setq asia_cd (getvar "dwgcodepage"))
(cond
( (or (= asia_cd "dos932")
(= asia_cd "ANSI_932")
)
(or (and (<= 129 code) (<= code 159))
(and (<= 224 code) (<= code 252))
)
)
( (or (= asia_cd "big5")
(= asia_cd "ANSI_950")
)
(and (<= 129 code) (<= code 254))
)
( (or (= asia_cd "gb2312")
(= asia_cd "ANSI_936")
)
(and (<= 161 code) (<= code 254))
)
( (or (= asia_cd "johab")
(= asia_cd "ANSI_1361")
)
(and (<= 132 code) (<= code 211))
)
( (or (= asia_cd "ksc5601")
(= asia_cd "ANSI_949")
)
(and (<= 129 code) (<= code 254))
)
)
)
;;; ====================================================
;;;
;;; FITSTR2LEN
;;;
;;; Truncates the given string to the given length.
;;; This function should be used to fit symbol table names, that
;;; may turn into \U+ sequences into a given size to be displayed
;;; inside a dialog box.
;;;
;;; Ex: the following string:
;;;
;;; "This is a long string that will not fit into a 32 character static text box."
;;;
;;; would display as a 32 character long string as follows:
;;;
;;; "This is a long...tatic text box."
;;;
(defun fitstr2len (str1 maxlen)
;;; initialize internals
(setq tmpstr str1)
(setq len (strlen tmpstr))
(if (> len maxlen)
(progn
(setq maxlen2 (/ maxlen 2))
(if (> maxlen (* maxlen2 2))
(setq maxlen2 (- maxlen2 1))
)
(if (is_lead_byte (substr tmpstr (- maxlen2 2) 1))
(setq tmpstr1 (substr tmpstr 1 (- maxlen2 3)))
(setq tmpstr1 (substr tmpstr 1 (- maxlen2 2)))
)
(if (is_lead_byte (substr tmpstr (- len (- maxlen2 1)) 1))
(setq tmpstr2 (substr tmpstr (- len (- maxlen2 3))))
(setq tmpstr2 (substr tmpstr (- len (- maxlen2 2))))
)
(setq str2 (strcat tmpstr1 "..." tmpstr2))
) ;;; progn
(setq str2 (strcat tmpstr))
) ;;; if
) ;;; defun
;;;
;;; If the first object in a selection set has an attached URL
;;; Then launch browser and point to the URL.
;;; Called by the Grips Cursor Menu
;;;
(defun C:gotourl ( / ssurl url i)
(setq m:err *error* *error* *merrmsg* i 0)
; if some objects are not already pickfirst selected,
; then allow objects to be selected
(if (not (setq ssurl (ssget "_I")))
(setq ssurl (ssget))
)
; if geturl LISP command not found then load arx application
(if (/= (type geturl) 'EXRXSUBR)
(arxload "acapp")
)
; Search list for first object with an URL
(while (and (= url nil) (< i (sslength ssurl)))
(setq url (geturl (ssname ssurl i))
i (1+ i))
)
; If an URL has be found, open browser and point to URL
(if (= url nil)
(alert "对象未关联统一资源定位符。")
(command "_.browser" url)
)
(setq *error* m:err m:err nil)
(princ)
)
;; Used by the import dialog to silently load a 3ds file
(defun import3ds (filename / filedia_old render)
;; Load Render if not loaded
(setq render (findfile "acRender.arx"))
(if render
(verify_arxapp_loaded render)
(quit)
)
;; Save current filedia & cmdecho setting.
(setq filedia-save (getvar "FILEDIA"))
(setq cmdecho-save (getvar "CMDECHO"))
(setvar "FILEDIA" 0)
(setvar "CMDECHO" 0)
;; Call 3DSIN and pass in filename.
(c:3dsin 1 filename)
;; Reset filedia & cmdecho
(setvar "FILEDIA" filedia-save)
(setvar "CMDECHO" cmdecho-save)
(princ)
)
;;;----------------------------------------------------------------------------
; New "Select All" function. Cannot be called transparently.
(defun c:ai_selall ( / ss old_error a b old_cmd old_pkadd)
(setq a "CMDECHO" b "PICKADD"
old_cmd (getvar a) old_pkadd (getvar b)
old_error *error* *error* ai_error)
(if (ai_notrans)
(progn
(princ "正在选择对象...")
(setvar a 0)
(setvar b 2)
(initcommandversion -1)
(command "_.SELECT" "_ALL" "")
(setvar a old_cmd)
(setvar b old_pkadd)
(princ "完成。\n")
)
)
(setq *error* old_error old_error nil ss nil)
(princ)
)
;;;
;;; Routines that check CMDACTIVE and post an alert if the calling routine
;;; should not be called in the current CMDACTIVE state. The calling
;;; routine calls (ai_trans) if it can be called transparently or
;;; (ai_notrans) if it cannot.
;;;
;;; 1 - Ordinary command active.
;;; 2 - Ordinary and transparent command active.
;;; 4 - Script file active.
;;; 8 - Dialogue box active.
;;;
(defun ai_trans ()
(if (zerop (logand (getvar "cmdactive") (+ 2 8) ))
T
(progn
(alert "不可以透明调用该命令。")
nil
)
)
)
(defun ai_transd ()
(if (zerop (logand (getvar "cmdactive") (+ 2) ))
T
(progn
(alert "不可以透明调用该命令。")
nil
)
)
)
(defun ai_notrans ()
(if (zerop (logand (getvar "cmdactive") (+ 1 2 8) ))
T
(progn
(alert "不可以透明调用该命令。")
nil
)
)
)
;;;----------------------------------------------------------------------------
; New function for invoking the product support help through the browser
(defun C:ai_product_support ()
(setq url "http://www.autodesk.com/autocad-support-chs")
(command "_.browser" url)
)
(defun C:ai_product_support_safe ()
(setq url "http://www.autodesk.com/autocad-support-chs")
(setq 404page "WSProdSupp404.htm")
(command "_.browser2" 404page url)
)
(defun C:ai_training_safe ()
(setq url "http://www.autodesk.com/autocad-training-chs")
(setq 404page "WSTraining404.htm")
(command "_.browser2" 404page url)
)
(defun C:ai_custom_safe ()
(setq url "http://www.autodesk.com/developautocad")
(setq 404page "WSCustom404.htm")
(command "_.browser2" 404page url)
)
;;; ==== Originally defined in Acad.mnl ====
;;; These were moved to this file to ease migration.
(princ "\nAutoCAD 菜单实用工具 ")
;;;=== Icon Menu Functions ===
;;; View -> Layout -> Tiled Viewports...
(defun ai_tiledvp_chk (new)
(setq m:err *error* *error* *merrmsg*)
(if (= (getvar "TILEMODE") 0)
(progn
(princ "\n** 该命令不允许在布局中使用 **")
(princ)
)
(progn
(if new
(menucmd "I=ACAD.IMAGE_VPORTI")
(menucmd "I=IMAGE_VPORTI")
)
(menucmd "I=*")
)
)
(setq *error* m:err m:err nil)
(princ)
)
(defun ai_tiledvp (num ori / ai_tiles_g ai_tiles_cmde)
(setq m:err *error* *error* *merrmsg*
ai_tiles_cmde (getvar "CMDECHO")
ai_tiles_g (getvar "GRIDMODE")
)
(ai_undo_push)
(setvar "CMDECHO" 0)
(setvar "GRIDMODE" 0)
(cond ((= num 1)
(command "_.VPORTS" "_SI")
(setvar "GRIDMODE" ai_tiles_g)
)
((< num 4)
(command "_.VPORTS" "_SI")
(command "_.VPORTS" num ori)
(setvar "GRIDMODE" ai_tiles_g)
)
((= ori nil)
(command "_.VPORTS" "_SI")
(command "_.VPORTS" num)
(setvar "GRIDMODE" ai_tiles_g)
)
((= ori "_L")
(command "_.VPORTS" "_SI")
(command "_.VPORTS" "2" "")
(setvar "CVPORT" (car (cadr (vports))))
(command "_.VPORTS" "2" "")
(command "_.VPORTS" "_J" "" (car (cadr (vports))))
(setvar "CVPORT" (car (cadr (vports))))
(command "_.VPORTS" "3" "_H")
(setvar "GRIDMODE" ai_tiles_g)
(setvar "CVPORT" (car (cadddr (vports))))
(setvar "GRIDMODE" ai_tiles_g)
(setvar "CVPORT" (car (cadddr (vports))))
(setvar "GRIDMODE" ai_tiles_g)
(setvar "CVPORT" (car (cadddr (vports))))
(setvar "GRIDMODE" ai_tiles_g)
)
(T
(command "_.VPORTS" "_SI")
(command "_.VPORTS" "2" "")
(command "_.VPORTS" "2" "")
(setvar "CVPORT" (car (caddr (vports))))
(command "_.VPORTS" "_J" "" (car (caddr (vports))))
(setvar "CVPORT" (car (cadr (vports))))
(command "_.VPORTS" "3" "_H")
(setvar "GRIDMODE" ai_tiles_g)
(setvar "CVPORT" (car (cadddr (vports))))
(setvar "GRIDMODE" ai_tiles_g)
(setvar "CVPORT" (car (cadddr (vports))))
(setvar "GRIDMODE" ai_tiles_g)
(setvar "CVPORT" (car (cadddr (vports))))
(setvar "GRIDMODE" ai_tiles_g)
)
)
(ai_undo_pop)
(setq *error* m:err m:err nil)
(setvar "CMDECHO" ai_tiles_cmde)
(princ)
)
;;;=== General Utility Functions ===
;;; ai_popmenucfg -- retrieve parameter from cfg settings
;;; <param> is a string specifiying the parameter
(defun ai_popmenucfg (param)
(set (read param) (getcfg (strcat "CfgData/Menu/" param)))
)
;;; ai_putmenucfg -- store parameter in cfg settings
;;; <param> is a string specifiying the parameter
;;; <cfgval> is the value for that parameter
(defun ai_putmenucfg (param cfgval)
(setcfg (strcat "CfgData/Menu/" param) cfgval)
)
(defun *merr* (msg)
(ai_sysvar nil) ;; reset system variables
(setq *error* m:err m:err nil)
(princ)
)
(defun *merrmsg* (msg)
(princ msg)
(setq *error* m:err m:err nil)
(princ)
)
(defun ai_showedge_alert ()
(alert "下次重生成时显示不可见边。")
(princ)
)
(defun ai_hideedge_alert ()
(alert "下次重生成时隐藏不可见边。")
(princ)
)
(defun ai_viewports_alert ()
(princ "** 该命令不允许在模型选项卡中使用 **")
(setq *error* m:err m:err nil)
(princ)
)
(defun ai_refedit_alert ()
(princ "\n** 除非参照已用 REFEDIT 命令检查，否则不允许使用该命令 **")
(setq *error* m:err m:err nil)
(princ)
)
;;; --- ai_sysvar ------------------------------------------
;;; Change system variable settings and save current settings
;;; (Note: used by *merr* to restore system settings on error.)
;;;
;;; The <vars> argument is used to...
;;; restore previous settings (ai_sysvar NIL)
;;; set a single sys'var (ai_sysvar '("cmdecho" . 0))
;;; set multiple sys'vars (ai_sysvar '(("cmdecho" . 0)("gridmode" . 0)))
;;;
;;; defun-q is needed by Visual Lisp for functions which redefine themselves.
;;; it is aliased to defun for seamless use with AutoLISP.
(defun-q ai_sysvar (vars / savevar pair varname varvalue varlist)
(setq varlist nil) ;; place holder for varlist
(defun savevar (varname varvalue / pair)
(cond
;; if new value is NIL, save current setting
((not varvalue)
(setq varlist
(cons
(cons varname (getvar varname))
varlist
)
)
)
;; change sys'var only if it's different
((/= (getvar varname) varvalue)
;; add current setting to varlist, change setting
(setq varlist
(cons
(cons varname (getvar varname))
varlist
)
)
(setvar varname varvalue)
)
(T nil)
)
)
(cond
;; reset all values
((not vars)
(foreach pair varlist
(setq varname (car pair)
varvalue (cdr pair)
)
(setvar varname varvalue)
)
(setq varlist nil)
)
((not (eq 'LIST (type vars)))
(princ "\nAI_SYSVAR: 参数类型错。\n")
)
;; set a single system variable
((eq 'STR (type (car vars)))
(savevar (car vars) (cdr vars))
)
;; set multiple system variables
((and
(eq 'LIST (type (car vars)))
(eq 'STR (type (caar vars)))
)
(foreach pair vars
(setq varname (car pair)
varvalue (cdr pair)
)
(if (not (eq 'STR (type varname)))
(princ "\nAI_SYSVAR: 参数类型错。\n")
(savevar varname varvalue)
)
)
)
(T (princ "\nAI_SYSVAR: 第一个参数有错。\n"))
);cond
;; redefine ai_sysvar function to contain the value of varlist
(setq ai_sysvar
(cons (car ai_sysvar)
(cons (list 'setq 'varlist (list 'quote varlist))
(cddr ai_sysvar)
)
)
)
varlist ;; return the list
);sysvar
;;; return point must be on an entity
;;;
(defun ai_entsnap (msg osmode / entpt)
(while (not entpt)
(setq entpt (last (entsel msg)))
)
(if osmode
(setq entpt (osnap entpt osmode))
)
entpt
)
;;;
;;; These UNDO handlers are taken from ai_utils.lsp and copied here to
;;; avoid loading all of ai_utils.lsp. Command echo control has also
;;; been added so that UNDO commands aren't echoed everywhere.
;;;
;;; UNDO handlers. When UNDO ALL is enabled, Auto must be turned off and
;;; GROUP and END added as needed.
;;;
(defun ai_undo_push()
(ai_sysvar '("cmdecho" . 0))
(setq undo_init (getvar "undoctl"))
(cond
((and (= 1 (logand undo_init 1)) ; enabled
(/= 2 (logand undo_init 2)) ; not ONE (ie ALL is ON)
(/= 8 (logand undo_init 8)) ; no GROUP active
)
(command "_.undo" "_group")
)
(T)
)
;; If Auto is ON, turn it off.
(if (= 4 (logand 4 undo_init))
(command "_.undo" "_auto" "_off")
)
(ai_sysvar NIL)
)
;;;
;;; Add an END to UNDO and return to initial state.
;;;
(defun ai_undo_pop()
(ai_sysvar '("cmdecho" . 0))
(cond
((and (= 1 (logand undo_init 1)) ; enabled
(/= 2 (logand undo_init 2)) ; not ONE (ie ALL is ON)
(/= 8 (logand undo_init 8)) ; no GROUP active
)
(command "_.undo" "_end")
)
(T)
)
;; If it has been forced off, turn it back on.
(if (= 4 (logand undo_init 4))
(command "_.undo" "_auto" "_on")
)
(ai_sysvar NIL)
)
;;;=== Menu Functions ======================================
(defun ai_rootmenus ()
(setq T_MENU 0)
(menucmd "S=S")
(menucmd "S=ACAD.S")
(princ)
)
(defun c:ai_fms ( / fmsa fmsb)
(setq m:err *error* *error* *merr*)
(ai_undo_push)
(if (getvar "TILEMODE") (setvar "TILEMODE" 0))
(setq fmsa (vports) fmsb (nth 0 fmsa))
(if (member 1 fmsb)
(if (> (length fmsa) 1)
(command "_.mspace")
(progn
(ai_sysvar '("cmdecho" . 1))
(command "_.mview")
(while (eq 1 (logand 1 (getvar "CMDACTIVE")))
(command pause)
)
(ai_sysvar NIL)
(command "_.mspace")
)
)
)
(ai_undo_pop)
(setq *error* m:err m:err nil)
(princ)
)
(defun ai_onoff (var)
(setvar var (abs (1- (getvar var))))
(princ)
)
;;; go to paper space
(defun c:ai_pspace ()
(ai_undo_push)
(if (/= 0 (getvar "tilemode"))
(command "_.tilemode" 0)
)
(if (/= 1 (getvar "cvport"))
(command "_.pspace")
)
(ai_undo_pop)
(princ)
)
;;; go to tilemode 1
(defun c:ai_tilemode1 ()
(ai_undo_push)
(if (/= 1 (getvar "tilemode"))
(command "_.tilemode" 1)
)
(ai_undo_pop)
(princ)
)
;;; Pop menu Draw/ Dim/ Align Text/ Centered
;;; Toolbar Dimensions/ Align Text/ Centered
(defun ai_dim_cen (/ ai_sysvar ai_dim_ss)
(setq ai_sysvar (getvar "cmdecho"))
(setvar "cmdecho" 0)
(cond
((setq ai_dim_ss (ssget "_P" '((0 . "DIMENSION"))))
(command "_.dimoverride" "_dimjust" 0 "" ai_dim_ss ""
"_.dimtedit" ai_dim_ss "_h")
)
(T nil)
)
(setvar "cmdecho" ai_sysvar)
(princ)
)
;;; Shortcut menu for Dimension Text Above
(defun c:ai_dim_textabove (/ ss)
(ai_sysvar '("cmdecho" . 0))
(if (setq ss (ssget "_I"))
(command "_.dimoverride" "_dimtad" 3 "" ss "")
(if (setq ss (ssget))
(command "_.dimoverride" "_dimtad" 3 "" ss "")
)
)
(ai_sysvar NIL)
(princ)
)
;;; Shortcut menu for Dimension Text Center
(defun c:ai_dim_textcenter (/ ss)
(ai_sysvar '("cmdecho" . 0))
(if (setq ss (ssget "_I"))
(command "_.dimoverride" "_dimtad" 0 "" ss "")
(if (setq ss (ssget))
(command "_.dimoverride" "_dimtad" 0 "" ss "")
)
)
(ai_sysvar NIL)
(princ)
)
;;; Shortcut menu for Dimension Text Home
(defun c:ai_dim_texthome (/ ss)
(ai_sysvar '("cmdecho" . 0))
(if (setq ss (ssget "_I"))
(command "_.dimedit" "_h")
(if (setq ss (ssget))
(command "_.dimedit" "_h" ss)
)
)
(ai_sysvar NIL)
(princ)
)
;;; Screen menu item for CIRCLE TaTaTan option.
;;; first, get points on entities
(defun ai_circtanstart()
(setq m:err *error* *error* *merr*)
(ai_sysvar
(list '("cmdecho" . 0)
;; make sure _tan pick for CIRCLE gets same entity
(cons "aperture" (getvar "pickbox"))
)
)
;; prompts are the same as CIRCLE/TTR command option
(setq pt1 (ai_entsnap "\n输入切点定义: " nil))
(setq pt2 (ai_entsnap "\n输入第二个切点的定义: " nil))
(setq pt3 (ai_entsnap "\n输入第三个切点的定义: " nil))
)
;;; Command-line version
(defun c:ai_circtan (/ pt1 pt2 pt3)
(ai_circtanstart)
(ai_sysvar '("osmode" . 256))
(command "_.circle" "_3p" "_tan" pt1 "_tan" pt2 "_tan" pt3)
(ai_sysvar nil)
(setq *error* m:err m:err nil)
(princ)
)
;;; Use this if CMDNAMES == CIRCLE
(defun ai_circtan (/ pt1 pt2 pt3)
(ai_circtanstart)
(ai_sysvar '("osmode" . 256))
(command "_3p" pt1 pt2 pt3)
(ai_sysvar nil)
(setq *error* m:err m:err nil)
(princ)
)
;;; Shortcut menu Deselect All item.
(defun ai_deselect ()
(if (= (getvar "cmdecho") 0) ;start if
(command "_.select" "_r" "_all" "")
(progn ;start progn for cmdecho 1
(setvar "cmdecho" 0)
(command "_.select" "_r" "_all" "")
(setvar "cmdecho" 1)
) ;end progn for cmdecho 1
) ;end if
(terpri)
(prompt "所有对象都已取消选择")
(princ)
)
;;; Command version of ai_deselect to be called from the CUI
;;; so it gets properly recorded by the Action Recorder
;;;
(defun c:ai_deselect ()
(ai_deselect)
(princ)
)
;;;
;;; Enable Draworder to be called from a menu
;;; Checks for Pickfirst selected objects
;;;
(defun ai_draworder (option / ss )
(setq m:err *error* *error* *merr*)
(ai_sysvar '("cmdecho" . 0))
(if (setq ss (ssget "_I"))
(command "_.draworder" option)
(if (setq ss (ssget))
(command "_.draworder" ss "" option)
)
)
(ai_sysvar NIL)
(setq *error* m:err m:err nil)
(princ)
)
;;; Command version of ai_draworder to be called from the CUI
;;; so it gets properly recorded by the Action Recorder
;;;
(defun c:ai_draworder ()
(initget "Above Under Front Back")
(ai_draworder (strcat "_" (getkword)))
(princ)
)
(defun c:vlisp ()
(if (/= nil c:vlide) (c:vlide))
)
(princ "已加载。")
;; Silent load.
(princ)
;;;-----BEGIN-SIGNATURE-----
;;; UAoAADCCCkwGCSqGSIb3DQEHAqCCCj0wggo5AgEBMQ8wDQYJKoZIhvcNAQELBQAw
;;; CwYJKoZIhvcNAQcBoIIHaDCCB2QwggVMoAMCAQICEA4NuwSYzIKGkwcyf5wXD8sw
;;; DQYJKoZIhvcNAQELBQAwaTELMAkGA1UEBhMCVVMxFzAVBgNVBAoTDkRpZ2lDZXJ0
;;; LCBJbmMuMUEwPwYDVQQDEzhEaWdpQ2VydCBUcnVzdGVkIEc0IENvZGUgU2lnbmlu
;;; ZyBSU0E0MDk2IFNIQTM4NCAyMDIxIENBMTAeFw0yMjA4MDUwMDAwMDBaFw0yMzA4
;;; MDUyMzU5NTlaMGkxCzAJBgNVBAYTAlVTMRMwEQYDVQQIEwpDYWxpZm9ybmlhMRMw
;;; EQYDVQQHEwpTYW4gUmFmYWVsMRcwFQYDVQQKEw5BdXRvZGVzaywgSW5jLjEXMBUG
;;; A1UEAxMOQXV0b2Rlc2ssIEluYy4wggIiMA0GCSqGSIb3DQEBAQUAA4ICDwAwggIK
;;; AoICAQDi5pcIp9vO2hdmo2sLgbBQFaGobtbE1HyFCuRxFMeR124Yxnjddq/S1q6y
;;; SZeNFwA3+BC0Ba9ucDCcW2YibvH1I/c7En6PVTeO3+ioqGU08nB3Fe34E8w06Lra
;;; VE95uqyWI1Bin2GJ8gIICaoZEmf3euyYCnhgc28lF4LR8JEgD7ANh6JQ4a6VXMOP
;;; DwHMUKMSciIFTU0M+pWA28RAN/XzSHmO3jm9P3jK71p/pnr2EMJa36okS2518clo
;;; 3e/0B1TJUqZfYEiEFVATsKkrt/ExQ1OIGiDo/moah4Bv79aV8z1ZxQ5Q80znpRZp
;;; Sc3wM4RS29ZAPpNGd+xmBJZZa5Smbg4PDGE6buYQYP+lDdfyydxLacKXZX2p5snK
;;; RbV0QYL9QIKBOs1zBX50dqwlJv7JEZzZEpzFaGsPFlhRcjz6A00L2HoDN5qruQn2
;;; fgSvEyBu4tNgvgDTjfreVLFwxePz6a5ppZ9e6jfE6xd8KnPdy54eaRcIGpSHWP24
;;; LWT1lrgJDjJfEsM+mykhsDUWikVNOM4HxViuxn3TEb2ApX2TUtF6MO+OSsc/TnZz
;;; +lk6Wi0lCrp5XqvAPwQUFY0Im2ljNaqEG1XZ5lhqqZuKTYbuIf1LqDks28G6a1Bi
;;; VCWsuQW8Y1PLyK9gR3e4XyGPrLjiVVvOXKeqOLOyVY52rqmoOwIDAQABo4ICBjCC
;;; AgIwHwYDVR0jBBgwFoAUaDfg67Y7+F8Rhvv+YXsIiGX0TkIwHQYDVR0OBBYEFFpg
;;; X3UHe8qo4A3YomDtyEKjjkq2MA4GA1UdDwEB/wQEAwIHgDATBgNVHSUEDDAKBggr
;;; BgEFBQcDAzCBtQYDVR0fBIGtMIGqMFOgUaBPhk1odHRwOi8vY3JsMy5kaWdpY2Vy
;;; dC5jb20vRGlnaUNlcnRUcnVzdGVkRzRDb2RlU2lnbmluZ1JTQTQwOTZTSEEzODQy
;;; MDIxQ0ExLmNybDBToFGgT4ZNaHR0cDovL2NybDQuZGlnaWNlcnQuY29tL0RpZ2lD
;;; ZXJ0VHJ1c3RlZEc0Q29kZVNpZ25pbmdSU0E0MDk2U0hBMzg0MjAyMUNBMS5jcmww
;;; PgYDVR0gBDcwNTAzBgZngQwBBAEwKTAnBggrBgEFBQcCARYbaHR0cDovL3d3dy5k
;;; aWdpY2VydC5jb20vQ1BTMIGUBggrBgEFBQcBAQSBhzCBhDAkBggrBgEFBQcwAYYY
;;; aHR0cDovL29jc3AuZGlnaWNlcnQuY29tMFwGCCsGAQUFBzAChlBodHRwOi8vY2Fj
;;; ZXJ0cy5kaWdpY2VydC5jb20vRGlnaUNlcnRUcnVzdGVkRzRDb2RlU2lnbmluZ1JT
;;; QTQwOTZTSEEzODQyMDIxQ0ExLmNydDAMBgNVHRMBAf8EAjAAMA0GCSqGSIb3DQEB
;;; CwUAA4ICAQCflGPavxEna7llFy4JcUGqAfYQxElzlwzF5AlzCEkkk0IcZwJAWxkV
;;; npL9sTFx4idVniRi7ZeTmX5dKNiNK9g1oRw0kDZOn1n49IpNZDXVIlsKnTuAKub9
;;; 8qR7okQ8pt7/2aXEqiXdN01vgH2WBKyr0Z10aWjjM6FrhryLW905jlSYtrpplr8n
;;; XEbWepiKR+X76myg/2mWkB1NLdk6OA9E6qFs8mi+vzBfdsj/pWMEucOEAOburpBt
;;; 92Nwgb3n+KFawxPWm8w4n1GjO/up8k/BuTooJNK0lnXXlMJVexGYytN4oBj3pQW9
;;; 0kH+vVkkbtm5QLi/ez1RT4qFCb3/Ejlm8dT17pzTg/fyL1tYbrgBLdnJWheub1Ak
;;; 3H0Z7PjCxqCt6dJEX6JrAV0bfyTdq4zaWccDx6QYsW6gLfXA7y+RAh8OoR0/IE5m
;;; 1LIC3gs5yr/00GSCEtS1LyzgNl7/dPN/WiGhOjLRN+Qpa0awwRbLjdRxp3ekt9A2
;;; wt44GLEBvdzkdViGx1c1o8I8U1i45wLILGj77ot2C08dVLyZo/5jSkobzzZAFZMK
;;; e0/UxFgj93IUauGInxxCTsbXOK87UTuTOQQwRPT5zn8NvH/bMCXgwOT3pFYg4e/x
;;; t7U0nyOmIi48VPo3PgLiiD/L5pe3zJJx/UPyF9TJSkLRJWYTFPg7QDGCAqgwggKk
;;; AgEBMH0waTELMAkGA1UEBhMCVVMxFzAVBgNVBAoTDkRpZ2lDZXJ0LCBJbmMuMUEw
;;; PwYDVQQDEzhEaWdpQ2VydCBUcnVzdGVkIEc0IENvZGUgU2lnbmluZyBSU0E0MDk2
;;; IFNIQTM4NCAyMDIxIENBMQIQDg27BJjMgoaTBzJ/nBcPyzANBgkqhkiG9w0BAQsF
;;; ADANBgkqhkiG9w0BAQEFAASCAgCYJSfjBZCYGRePxCzLIkAYW37fIsOlEjqGXh+Y
;;; /up+sPj1N+H7VPQJ1Ceis2EQcSUFX7IFXf1CUC5v7k9WqCc8T/g0059vfp9dRhfq
;;; fn9Rjw2ac65uKmYM64bc0lT9gPwjfVKWknPOJSe0WvObOuR5qOWo4e5Haa8jN30q
;;; 2qvCj/fU4DtWtzL56vEKtOPsoOUwxhOBs0Z272UvV95mpOkZocXTlDiv/tUXLjgQ
;;; yPCTgSwjgqZMs6TXUT/bXcOxeCXSDsoUnL9gkm06nTWZ4MCDC3hhf5GUHlsT58NQ
;;; e+kImJP8uKl3CAUXNUqFzGo8ifdF+NmA8IRZNGIis5T6hK9a4Ycw5QLtUAHZL6iN
;;; 5dXgMKrNqfn9jSEVbeLbPvjTsH6eSh+ofGCVwHwleaHdIotuT/zKVCogTXfbpQQz
;;; WUNTvBHZsx6VPgOKIlpY8rtV8q2+XQyBE+KKP7T9+XKqdSOIJA/vsVmA3091MUtz
;;; KB6OydCsJf5bSTwd1JlGl5navwUdW/LLnYgYoSzzv7c8QzLnxMBu7t9PHN5q8LsX
;;; uXzLNsSx3e1PGJgTZWROaNRZxIU/yBxnW8E8LkZqn+M8vOY7JlHE9VDIy37RBzGh
;;; o2ZVqgROWo9BNhdiGZ7Z09IOofjGI066nQf6GNuSIyJRa/uQcgcbRSKYGiFBQw/4
;;; L+EBng==
;;; -----END-SIGNATURE-----
扫一扫
评论
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
查看更多评论
添加红包
