;;特别字符处理(ACET-STR-ESC-WILDCARDS "#a@b");"`#a`@b"
(defun ACET-STR-ESC-WILDCARDS (A / X LST)
(SETQ LST '("#" "@" "." "*" "?" "~" "[" "]" ","))
(foreach X LST
(SETQ A (ACET-STR-REPLACE X (STRCAT "`" X) A))
)
A
)
;;(ACET-STR-REPLACE "B" "2" "ssABCsBs");"ssA2Cs2s"
(defun ACET-STR-REPLACE1 (o n s)
(XD::String:Replace (strcat "[" o "]") s n "I")
)
;;(ACET-STR-TO-LIST "B" "ssABCsBs");("ssA" "Cs" "s")
(defun ACET-STR-TO-LIST1 (d str)
(XD::String:RegExpS (strcat "[^" d "]+") str "I")
)
;;(ACET-STR-WCMATCH "ssABCsBs" "*c*");T
(defun ACET-STR-WCMATCH1 (str f)
(if (XD::String:RegExpS (strcat "[" f "]+") str "") T)
)
;; 用正则表达式替换字符 by 梁雄啸.2007.7
(defun XD::String:Replace (pat str nstr key / end)
(vl-load-com)
(if (not *xxvbsexp)
(setq *xxvbsexp (vlax-get-or-create-object "VBScript.RegExp"))
)
(vlax-put *xxvbsexp 'Pattern pat)
(if (not key)(setq key ""))
(setq key (strcase key))
(setq keys '(("I""IgnoreCase")("G""Global")("M""Multiline")))
(mapcar '(lambda(x)
(if (wcmatch key (strcat "*" (car x) "*"))
(vlax-put *xxvbsexp (read(cadr x)) 0)
(vlax-put *xxvbsexp (read(cadr x)) -1)
))
keys)
(vlax-invoke *xxvbsexp 'replace str nstr)
)
;|
ACET-STR-WCMATCH (EXRXSUBR)
ACET-STR-TO-LIST (SUBR)
ACET-STR-SPACE-TRIM (SUBR)
ACET-STR-REPLACE (EXRXSUBR)
ACET-STR-M-FIND (SUBR)
ACET-STR-LR-TRIM (SUBR)
ACET-STR-LIST-SELECT (SUBR)
ACET-STR-IS-PRINTABLE (SUBR)
ACET-STR-FORMAT (EXRXSUBR)
ACET-STR-FIND (EXRXSUBR)
ACET-STR-ESC-WILDCARDS (SUBR)
ACET-STR-EQUAL (EXRXSUBR)
ACET-STR-ENV-EXPAND (SUBR)
ACET-STR-COLLATE (EXRXSUBR)
|;
;;限定角度在0~2pi之间
(defun ACET-ANGLE-FORMAT (A / B)
(SETQ B (+ PI PI))
(while (< A 0)
(SETQ A (+ A B))
)
(while (>= A B)
(SETQ A (- A B))
)
(if (EQUAL A B 1.0e-008)
(SETQ A 0.0)
)
A
)
(defun ACET-SYS-LMOUSE-DOWN ()
(< (ACET-SYS-KEYSTATE 1) 0)
)
(defun ACET-SYS-CONTROL-DOWN ()
(< (ACET-SYS-KEYSTATE 17) 0)
)
(defun ACET-SYS-SHIFT-DOWN ()
(< (ACET-SYS-KEYSTATE 16) 0)
)
;;取得用户坐标系
;;(ACET-UCS-GET (car (entsel)));((-1824.72 3183.16 0.0) (-0.389905 0.920855 0.0) (-0.920855 -0.389905 0.0))
;;(ACET-UCS-GET nil)世界坐标系
(defun ACET-UCS-GET (NA / E1 ORG XDIR YDIR)
(if (and NA
(SETQ E1 (ENTGET NA ("*")))
(= "VIEWPORT" (CDR (ASSOC 0 E1)))
(= 1 (CDR (ASSOC 71 E1)))
)
(SETQ ORG(CDR (ASSOC 110 E1))
XDIR (CDR (ASSOC 111 E1))
YDIR (CDR (ASSOC 112 E1))
)
(SETQ ORG(GETVAR "ucsorg");当前坐标系原点
XDIR (GETVAR "ucsxdir");当前空间中当前视口的当前 UCS 的 X 方向
YDIR (GETVAR "ucsydir");当前空间中当前视口的当前 UCS 的 Y 方向
)
)
(LIST ORG XDIR YDIR)
)
;;alert
(defun ACET-ALERT (MSG)
(if (NOT (EQUAL 4 (LOGAND 4 (GETVAR "cmdactive"))))
(ALERT MSG)
(PRINC (STRCAT "\n" MSG))
)
(PRINC)
)
;;表中第n项插入A
;;(ACET-LIST-INSERT-NTH 1 '(3 3 3 3) 2);(3 3 1 3 3)
(defun ACET-LIST-INSERT-NTH (A LST N / LST2 J)
(SETQ J 0)
(repeat N
(SETQ LST2 (CONS (NTH J LST) LST2))
(SETQ J (+ J 1))
)
(SETQ LST2 (CONS A LST2))
(repeat (- (LENGTH LST) N)
(SETQ LST2 (CONS (NTH J LST) LST2))
(SETQ J (+ J 1))
)
(REVERSE LST2)
)
;;图元列表增加默认值
(defun ACET-ELIST-ADD-DEFAULTS (E1 / N)
(SETQ N (VL-POSITION (ASSOC 8 E1) E1))
(SETQ N (+ N 1))
(if (NOT (ASSOC 6 E1))
(SETQ E1 (ACET-LIST-INSERT-NTH (CONS 6 "BYLAYER") E1 N)
N(+ N 1)
)
)
(if (NOT (ASSOC 39 E1))
(SETQ E1 (ACET-LIST-INSERT-NTH (CONS 39 0.0) E1 N)
N(+ N 1)
)
)
(if (NOT (ASSOC 48 E1))
(SETQ E1 (ACET-LIST-INSERT-NTH (CONS 48 1.0) E1 N)
N(+ N 1)
)
)
(if (NOT (ASSOC 62 E1))
(SETQ E1 (ACET-LIST-INSERT-NTH (CONS 62 256) E1 N)
N(+ N 1)
)
)
(if (NOT (ASSOC 370 E1))
(SETQ E1 (ACET-LIST-INSERT-NTH (CONS 370 255) E1 N)
N(+ N 1)
)
)
E1
)
;;返回文件目录(ACET-FILENAME-DIRECTORY "C:\\Program Files\\DTIImain.DCL");"C:\\Program Files\\"
(defun ACET-FILENAME-DIRECTORY (A / B)
(SETQ A (VL-FILENAME-DIRECTORY A))
(if (NOT A)
(SETQ A "")
)
(if (and (NOT (EQUAL A ""))
(SETQ B (SUBSTR A (STRLEN A) 1))
(NOT (EQUAL B "\\"))
(NOT (EQUAL B ":"))
(NOT (EQUAL B "/"))
)
(SETQ A (STRCAT A "\\"))
)
A
)
;;进度显示
(defun ACET-SPINNER ()
(if (NOT #SPIN)
(SETQ #SPIN "-")
)
(cond
((= #SPIN "-") (SETQ #SPIN "\\"))
((= #SPIN "\\") (SETQ #SPIN "|"))
((= #SPIN "|") (SETQ #SPIN "/"))
(t (SETQ #SPIN "-"))
)
(PRINC (STRCAT (CHR 8) #SPIN))
)
;;提取组码
(defun ACET-DXF (CODE E1)
(CDR (ASSOC CODE E1))
)
;;布局时，取得一个视口对象(ACET-PSPACE-VIEWPORT-ENAME)
(defun ACET-PSPACE-VIEWPORT-ENAME (/ SS)
(SETQ SS
(SSGET "_x"
(LIST '(0 . "VIEWPORT")
'(67 . 1)
'(69 . 1)
(CONS 410 (GETVAR "ctab"))
)
)
)
(if SS
(SSNAME SS 0)
)
)
页:
1
[2]