提供三个acet*.fas里面的自定义函数

ayl1004 · 发表于 2013-8-1 13:00:54

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

(
;; acettest.fas
(3 "ACET-AUTOLOAD-APPLY" 652)
(3 "ACET-ALERT" 651)
(3 "C:EXPRESSMENU" 650)
(3 "C:EXPRESSTOOLS" 649)
(3 "ACET-INIT-FAS-LIB" 648)
(3 "ACET-INIT-FORCE-LOAD-ARX-LIB" 647)
(3 "ACET-INIT-GET-LIB-DIR" 646)
(3 "ACET-INIT-ADD-LIB-DIR" 645)
(3 "ACET-INIT-EXPRESS-NOT-INSTALLED-MSG" 644)
(3 "ACET-HOW-TO-GET-EXPRESS" 643)
(3 "ACET-GO-TO-EXPRESS-PAGE" 642)
(3 "ACET-FILENAME-ACAD-ROOT" 641)
(3 "ACET-FILENAME-DIR-ON-PATH" 640)
(3 "ACET-INIT-EXPRESS-INSTALLED" 639)
(3 "ACET-AUTOLOAD" 638)
(3 "ACET-AUTOLOAD2" 637)
(3 "ACET-AUTOLOAD-EXEC" 636)
(3 "ACET-CMD-CHECK" 635)
(3 "ACET-INIT-EXCLUDE-LIST" 634)
(3 "ACET-DISABLED-COMMAND" 633)
(3 "ACET-INIT-PRODKEY" 632)
(3 "ACET-INIT-GET-UPDATE" 631)
(3 "ACET-PARTIAL-MENU-STATUS-GET" 630)
(3 "ACET-PARTIAL-MENU-STATUS-SET" 629)
(3 "ACET-FILE-SYSTIME-COMPARE" 628)
(3 "ACET-MENU-LOAD" 627)
(3 "ACET-MENU-LOAD2" 626)
(3 "ACET-REG-SETDEMANDLOAD" 625)
(3 "ACET-REG-SETCOMMAND" 624)
(3 "ACET-REG-SETACTIVEX" 623)
(3 "C:EXPRESSREG" 622)
(3 "ACET-INIT-CREATE-REG-ENTRIES" 621)
(3 "ACET-LSP-LOAD" 620)
(3 "ACET-INIT" 619)
(3 "LOCAL-CMD-FILE-NOT-INSTALLED" 618)
(3 "FORMAT-SYSTIME" 617)

;;acetdomnu.fas
(3 "C:REBUILD-EXPRESS-MENU" 366)
(3 "ACET-MENU-REBUILD" 365)
(3 "ACET-MENU-BUILD" 364)
(3 "ACET-MENU-DISABLE" 363)
(3 "ACET-MENU-POPUP-MAKE" 362)
(3 "ACET-MENU-TOOLBAR-HAS-COMMANDS" 361)
(3 "ACET-MENU-TOOLBAR-MAKE" 360)
(3 "ACET-MENU-CHILD-ITEM-LIST-GET" 359)
(3 "ACET-MENU-BUILD-VALID-ITEM" 358)
(3 "ACET-MENU-HELPSTRINGS-MAKE" 357)
(3 "ACET-INI-ITEM-LIST-GET" 356)
(3 "ACET-MENU-WRITE-HEADER" 355)
(3 "ACET-MENU-ADD-SPACES" 354)
(3 "ACET-STRING" 353)

;;acetutil.fas
(3 "ACET-LIST-INSERT-NTH" 1171)
(3 "ACET-GEOM-POINT-FUZ" 1170)
(3 "ACET-GEOM-LIST-FUZ" 1169)
(3 "ACET-ELIST-ADD-DEFAULTS" 1168)
(3 "ACET-FILENAME-DIRECTORY" 1167)
(3 "ACET-DICT-ENAME" 1166)
(3 "ACET-GEOM-VECTOR-SIDE" 1165)
(3 "ACET-ELIST-FILTER-NOT-MATCH" 1164)
(3 "ACET-ELIST-FILTER-AND-MATCH" 1163)
(3 "ACET-ELIST-FILTER-GC-MATCH" 1162)
(3 "ACET-ELIST-FILTER-OR-MATCH" 1161)
(3 "ACET-ELIST-FILTER--4-MATCH" 1160)
(3 "BNS_FILTER_MATCH" 1159)
(3 "ACET-ELIST-FILTER-MATCH" 1158)
(3 "ACET-FILENAME-EXTENSION" 1157)
(3 "ACET-FILENAME-PATH-REMOVE" 1156)
(3 "ACET-FILENAME-EXT-REMOVE" 1155)
(3 "ACET-STR-LR-TRIM" 1154)
(3 "ACET-STR-SPACE-TRIM" 1153)
(3 "ACET-STR-M-FIND" 1152)
(3 "ACET-STR-TO-LIST" 1151)
(3 "ACET-LIST-M-ASSOC" 1150)
(3 "ACET-GEOM-TEXTBOX" 1149)
(3 "ACET-GEOM-TXTBOX" 1148)
(3 "ACET-GEOM-MTXTBOX" 1147)
(3 "ACET-GEOM-MIDPOINT" 1146)
(3 "MAXMINPNT" 1145)
(3 "ACET-GEOM-LIST-EXTENTS" 1144)
(3 "ACET-GEOM-VIEW-POINTS" 1143)
(3 "ACET-GEOM-PIXEL-UNIT" 1142)
(3 "ACET-GEOM-OBJECT-POINT-LIST" 1141)
(3 "ACET-GEOM-PLINE-POINT-LIST" 1140)
(3 "ACET-GEOM-ARC-POINT-LIST" 1139)
(3 "ACET-GEOM-PLINE-ARC-INFO" 1138)
(3 "ACET-GEOM-ARC-DELTA-ANGLE" 1137)
(3 "ACET-GEOM-CALC-ARC-ERROR" 1136)
(3 "ACET-GEOM-ELLIPSE-POINT-LIST" 1135)
(3 "ACET-GEOM-ELLIPSE-POINT-AT-E-ANGLE" 1134)
(3 "ACET-GEOM-SPLINE-POINT-LIST" 1133)
(3 "ACET-GEOM-INSERT-POINT-LIST" 1132)
(3 "ACET-GEOM-INSERT-CLIP-LIST" 1131)
(3 "ACET-GEOM-MATRIX-TRANS" 1130)
(3 "ACET-GEOM-VECTOR-SCALE" 1129)
(3 "ACET-GEOM-ARBITRARY-X" 1128)
(3 "ACET-GEOM-M-TRANS" 1127)
(3 "ACET-GEOM-POINT-ROTATE" 1126)
(3 "ACET-GEOM-CROSS-PRODUCT" 1125)
(3 "ACET-GEOM-IMAGE-CLIP-LIST" 1124)
(3 "ACET-GEOM-TRANS-IMAGE-TO-UCS" 1123)
(3 "ACET-GEOM-IMAGE-BOUNDS" 1122)
(3 "ACET-GEOM-UNIT-VECTOR" 1121)
(3 "ACET-GEOM-DELTA-VECTOR" 1120)
(3 "ACET-GEOM-VECTOR-ADD" 1119)
(3 "ACET-GEOM-SS-EXTENTS" 1118)
(3 "ACET-GEOM-SS-EXTENTS-ACCURATE" 1117)
(3 "ACET-GEOM-SS-EXTENTS-FAST" 1116)
(3 "ACET-GEOM-EXTENTS" 1115)
(3 "ACET-SS-VISIBLE" 1114)
(3 "ACET-SS-ENTDEL" 1113)
(3 "ACET-SS-NEW" 1112)
(3 "ACET-SS-CLEAR-PREV" 1111)
(3 "ACET-ERROR-INIT" 1110)
(3 "ACET-ERROR-RESTORE" 1109)
(3 "ACET-UNDO-INIT" 1108)
(3 "ACET-UNDO-BEGIN" 1107)
(3 "ACET-UNDO-END" 1106)
(3 "ACET-UNDO-RESTORE" 1105)
(3 "ACET-CMD-EXIT" 1104)
(3 "ACET-SYSVAR-SET" 1103)
(3 "ACET-SYSVAR-RESTORE" 1102)
(3 "ACET-CALC-ROUND" 1101)
(3 "ACET-TABLE-NAME-LIST" 1100)
(3 "ACET-LAYER-LOCKED" 1099)
(3 "ACET-LAYER-UNLOCK-ALL" 1098)
(3 "ACET-LAYER-LOCKED-LIST" 1097)
(3 "ACET-TABLE-PURGE" 1096)
(3 "ACET-DICT-MAKE" 1095)
(3 "ACET-ARXLOAD-OR-BUST" 1094)
(3 "ACET-ARX-RE-LOAD" 1093)
(3 "ACET-SETVAR" 1092)
(3 "ACET-SETVAR-DWG" 1091)
(3 "ACET-SETVAR-CPROFILE" 1090)
(3 "ACET-SETVAR-FIXED-PROFILE" 1089)
(3 "ACET-GETVAR" 1088)
(3 "ACET-GETVAR-DWG" 1087)
(3 "ACET-GETVAR-CPROFILE" 1086)
(3 "ACET-GETVAR-FIXED-PROFILE" 1085)
(3 "ACET-DXF" 1084)
(3 "ACET-SPINNER" 1083)
(3 "ACET-CURRENTVIEWPORT-ENAME" 1082)
(3 "ACET-PSPACE-VIEWPORT-ENAME" 1081)
(3 "ACET-UCS-GET" 1080)
(3 "ACET-UCS-CMD" 1079)
(3 "ACET-SAFE-COMMAND" 1078)
(3 "ACET-ANGLE-FORMAT" 1077)
(3 "ACET-GEOM-VECTOR-D-ANGLE" 1076)
(3 "ACET-GEOM-Z-AXIS" 1075)
(3 "ACET-STR-ESC-WILDCARDS" 1074)
(3 "ACET-INSERT-SPACIAL-FILTER" 1073)
(3 "ACET-SS-FLT-CSPACE" 1072)
(3 "ACET-UI-PROGRESS-INIT" 1071)
(3 "ACET-UI-PROGRESS-SAFE" 1070)
(3 "ACET-UI-PROGRESS-DONE" 1069)
(3 "ACET-VBALOAD" 1068)
(3 "ACET-INIT-ACETUTIL-ARX" 1067)
)

ayl1004 · 发表于 2013-8-31 23:44:53

本帖最后由 ayl1004 于 2013-9-3 16:20 编辑

全部6个.fas的非完整.lsp文件，里面的单引号自己添加，跳转指令自己整理。

cie0588 · 发表于 2013-8-1 13:14:16

没看懂，有何用？

newer · 发表于 2013-8-1 15:41:28

我也没看懂楼主，是提供源代码，也没看到附件啊，还是只是告诉函数名？

ayl1004 · 发表于 2013-8-1 15:54:08

newer 发表于 2013-8-1 15:41
我也没看懂楼主，是提供源代码，也没看到附件啊，还是只是告诉函数名？

要是发了函数定义，那谁都知道fas了，这不天下大乱了吗？
再说，要整成lsp文件，我手头没有什么工具，只能靠手工。

newer · 发表于 2013-8-1 16:07:48

ayl1004 发表于 2013-8-1 15:54
要是发了函数定义，那谁都知道fas了，这不天下大乱了吗？
再说，要整成lsp文件，我手头没有什么工具，只 ...

那有函数的用法说明吗？

ayl1004 · 发表于 2013-8-1 17:38:06

本帖最后由 ayl1004 于 2013-8-1 17:39 编辑

newer 发表于 2013-8-1 16:07
那有函数的用法说明吗？

正在整fas---->lsp的工具，算法解密已经有了。

sicky111 · 发表于 2013-8-2 16:17:29

楼主啊，你在明经都已经被封号了，还不引以为戒啊？

newer · 发表于 2013-8-2 18:00:04

sicky111 发表于 2013-8-2 16:17
楼主啊，你在明经都已经被封号了，还不引以为戒啊？

看过楼主的帖子，都是技术性挺强的，怎么会被封号的呢？

ayl1004 · 发表于 2013-8-2 19:24:03

newer 发表于 2013-8-2 18:00
看过楼主的帖子，都是技术性挺强的，怎么会被封号的呢？

我就是尊重别人的劳动成果，所以才拿acet做研究，但是有些人不这么想，我也没办法。

/db_自贡黄明儒_ · 发表于 2013-8-4 12:11:04

ayl1004 发表于 2013-8-1 17:38
正在整fas---->lsp的工具，算法解密已经有了。

支持，迟早有人搞出来的，封号有什么用。

ayl1004 · 发表于 2013-8-4 14:48:00

/db_自贡黄明儒_ 发表于 2013-8-4 12:11
支持，迟早有人搞出来的，封号有什么用。

谢谢支持，我现在也不想整工具了，整出来了也不好公布，这种工具对VLISP来说，可是世界末日，反正自己看懂了就行。
其实反编译真的不是很难，我就不到半个月就把解密算法给弄明白了，有技术的可以试试。
有技术的人掌握了也不会去解密别人的东西，自己都能写，干嘛解你的。
我对LISP纯粹是爱好，好玩，自己也没弄什么工具，从没靠LISP赚过钱。
当然，解密fas也是因为好玩。

解密fas算法不需要其他语言基础，我对其他语言就不懂。

ayl1004 · 发表于 2013-8-4 14:57:05

再怎么说，fas也算是一门机器语言，它有自己的函数，有自己的指令，结构有点象汇编语言，有跳转指令，也就是常说的GOTO。
我现在在搞，怎么直接用fas编程。

newer · 发表于 2013-8-4 16:18:38

ayl1004 发表于 2013-8-4 14:48
谢谢支持，我现在也不想整工具了，整出来了也不好公布，这种工具对VLISP来说，可是世界末日，反正自己看 ...

楼主，你就把ACET的FAS函数源码给大家贴出来就行。

st788796 · 发表于 2013-8-4 16:35:17

ayl1004 发表于 2013-8-4 14:48
谢谢支持，我现在也不想整工具了，整出来了也不好公布，这种工具对VLISP来说，可是世界末日，反正自己看 ...

也不一定说是末日，对开源的来说无所谓，那些收费的可能就是末日了
据说国外N年前就有fas->lsp，只不过没有流传出来

ayl1004 · 发表于 2013-8-4 17:07:14

本帖最后由 ayl1004 于 2013-8-13 08:42 编辑

newer 发表于 2013-8-4 16:18
楼主，你就把ACET的FAS函数源码给大家贴出来就行。

我只是在研究的时候，弄过几个函数，自从被封号，现在都没弄了，而且只能手工整理表达式，太费时了
以下是我弄好的几个函数定义

(defun ACET-AUTOLOAD-APPLY (ACET:AUTOLOAD-APPLY-ARG-LST
ACET:AUTOLOAD-APPLY-ONFAIL
/
HLPTOPIC
HLPFILE
FUNCALL
FUN
)
(setq FUNCALL (READ (CADR ACET:AUTOLOAD-APPLY-ARG-LST))
FUN (CAR FUNCALL)
)
(if (ACET-INIT-FAS-LIB T ACET:AUTOLOAD-APPLY-ONFAIL)
(progn
(setq ACET:STUBFORCE T)
(ACET-AUTOLOAD ACET:AUTOLOAD-APPLY-ARG-LST)
(setq ACET:STUBFORCE nil)
(EVAL FUNCALL)
)
(progn
(PRINC "\nAutoload failed.")
(PRINC)
)
)
)
(defun ACET-ALERT (MSG)
(if (NOT (EQUAL 4 (LOGAND 4 (GETVAR "cmdactive"))))
(ALERT MSG)
(PRINC (STRCAT "\n" MSG))
)
(PRINC)
)
(defun C:EXPRESSMENU (/ ANS)
(if (ACET-INIT-FAS-LIB T nil)
(progn
(ACET-AUTOLOAD "(acet-menu-rebuild flag)" "acetdomnu")
(INITGET "Yes No")
(setq ANS
(GETKWORD
"\nPerform a full rebuild of the Express Tools menu before loading it? <N>: "
)
)
(if (= ANS "Yes")
(ACET-MENU-REBUILD T)
(ACET-MENU-LOAD2 "acetmain" "express" T)
)
)
)
(PRINC)
)
(defun C:EXPRESSTOOLS ()
(if (ACET-INIT-FAS-LIB T nil)
(ACET-MENU-LOAD2 "acetmain" "express" T)
)
(PRINC)
)
(defun ACET-INIT-FAS-LIB (FORCE ONFAIL / PATH DIR PASS)
(ACET-INIT-FORCE-LOAD-ARX-LIB)
(cond
((and ACET-ERROR-INIT (FINDFILE ACET:FAS-LIB))
(setq PASS T)
)
((and (setq DIR (ACET-INIT-GET-LIB-DIR))
(setq PATH (GETENV "ACAD"))
(or (ACET-FILENAME-DIR-ON-PATH DIR PATH)
(and FORCE (ACET-INIT-ADD-LIB-DIR DIR)))
(LOAD (STRCAT DIR ACET:FAS-LIB) nil)
)
(setq PASS T)
)
((and (NOT DIR) FORCE)
(if ONFAIL
(EVAL ONFAIL)
(ACET-INIT-EXPRESS-NOT-INSTALLED-MSG)
)
)
)
PASS
)
(defun ACET-INIT-FORCE-LOAD-ARX-LIB (/ PATH PASS)
(and (or (MEMBER ACET:ARX-LIB (ARX))
(and (setq PATH (ACET-INIT-GET-LIB-DIR))
(ARXLOAD (STRCAT PATH ACET:ARX-LIB) nil)
)
(ARXLOAD ACET:ARX-LIB nil)
)
(setq PASS T)
)
PASS
)
(defun ACET-INIT-GET-LIB-DIR (/ FNA)
(if (or (setq FNA (FINDFILE ACET:FAS-LIB))
(and (setq FNA (ACET-FILENAME-ACAD-ROOT))
(setq FNA (STRCAT FNA "Express\\" ACET:FAS-LIB))
(setq FNA (FINDFILE FNA))
)
)
(setq FNA (SUBSTR FNA 1 (- (STRLEN FNA) (STRLEN ACET:FAS-LIB))))
)
FAN
)
(defun ACET-INIT-ADD-LIB-DIR (DIR / FLAG ORIG PATH)
(if (and DIR (setq PATH (GETENV "ACAD")))
(if (NOT (setq FLAG (ACET-FILENAME-DIR-ON-PATH DIR PATH)))
(progn
(setq ORIG PATH)
(if (/= ";" (SUBSTR PATH (STRLEN PATH)))
(setq PATH (STRCAT PATH ";"))
)
(if (= "\\" (SUBSTR DIR (STRLEN DIR)))
(setq DIR (SUBSTR DIR 1 (1- (STRLEN DIR))))
)
(setq PATH (STRCAT PATH DIR))
(SETENV "ACAD" PATH)
(setq PATH (GETENV "ACAD"))
(if (NOT (setq FLAG (ACET-FILENAME-DIR-ON-PATH DIR PATH)))
(SETENV "ACAD" ORIG)
)
)
)
)
FLAG
)
(defun ACET-INIT-EXPRESS-NOT-INSTALLED-MSG (MSG)
(TEXTSCR)
(PRINC "\nThe Express Tools have not been installed on this system.")
(ACET-HOW-TO-GET-EXPRESS)
)
(defun ACET-HOW-TO-GET-EXPRESS (ANS)
(TEXTSCR)
(PRINC
(STRCAT
"\nTo get the very latest versions of all Express Tools, visit the"
"\nExpress Tools page on the Autodesk web site at: "
"\n "
ACET:WEBSITE
)
)
(INITGET "Yes No")
(setq ANS
(VL-CATCH-ALL-APPLY
'GETKWORD
"\n\nDo you want to go to the Express Tools web page now? <Y>: "
)
)
(if (or (NOT ANS) (= ANS "Yes"))
(ACET-GO-TO-EXPRESS-PAGE)
)
(PRINC)
)
(defun ACET-GO-TO-EXPRESS-PAGE (/ A FNA ID)
(setq A (STRCAT "HKEY_CLASSES_ROOT\\.htm"))
(if
(and (setq A (VL-REGISTRY-READ A))
(setq A (STRCAT "HKEY_CLASSES_ROOT\\" A "\\shell\\open\\command"))
(setq A (VL-REGISTRY-READ A))
)
(progn
(setq FNA A)
(setq A (SUBSTR A (MAX 1 (- (STRLEN A) 6))))
(setq A (XSTRCASE A))
(if (= "-NOHOME" A)
(setq FNA (SUBSTR FNA 1 (- (STRLEN FNA) 7)))
)
(setq A (SUBSTR FNA (- (STRLEN FNA) 1)))
(if (= A "%1")
(setq FNA (SUBSTR FNA 1 (- (STRLEN FNA) 2)))
)
(setq FNA (STRCAT FNA " " ACET:WEBSITE))
(setq ID (STARTAPP FNA))
)
)
(if (NOT ID)
(PRINC "\nUnable to start web browser.")
)
(PRINC)
)
(defun ACET-FILENAME-ACAD-ROOT (/ FNA KEY A)
(if (and (or (and (setq KEY (ACET-INIT-PRODKEY))
(setq KEY (STRCAT "HKEY_LOCAL_MACHINE\\" KEY))
(setq FNA (VL-REGISTRY-READ KEY "AcadLocation"))
)
(and (setq FNA (FINDFILE "acad.exe"))
(setq FNA (SUBSTR FNA 1 (- (STRLEN FNA) 8)))
)
)
FNA
(> (setq A (STRLEN FNA)) 0)
(/= "\\" (SUBSTR FNA A))
(/= "/" (SUBSTR FNA A))
)
(setq FNA (STRCAT FNA "\\"))
)
FNA
)
(defun ACET-SYS-LMOUSE-DOWN ()
(< (ACET-SYS-KEYSTATE 1) 0)
)
(defun ACET-SYS-CONTROL-DOWN (/ VBAPP ACADAPP)
(< (ACET-SYS-KEYSTATE 17) 0)
)
(defun ACET-SYS-SHIFT-DOWN (/ VBAPP ACADAPP)
(< (ACET-SYS-KEYSTATE 16) 0)
)
(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-GEOM-POINT-FUZ (P1 / P2 V1 V2 D)
(if (= (LENGTH P1) 2)
(SETQ P1 (LIST (CAR P1) (CADR P1) 0.0))
)
(SETQ V1 '(0.0 0.0 1.0))
(SETQ V2 (SIN (/ PI 4.0)))
(SETQ V2 (LIST V2 V2 V2))
(SETQ P2 (TRANS P1 V1 V2))
(SETQ P2 (TRANS P2 V2 V1))
(SETQ D (DISTANCE P1 P2))
(SETQ P1 (MAPCAR (LAMBDA (X) (* X 2.0)) P1))
(SETQ P2 (TRANS P1 V1 V2))
(SETQ P2 (TRANS P2 V2 V1))
(SETQ D (MAX D (DISTANCE P1 P2)))
D
)
(defun ACET-GEOM-LIST-FUZ (LST)
(SETQ LST (ACET-GEOM-LIST-EXTENTS LST))
(MAX (ACET-GEOM-POINT-FUZ (CAR LST)) (ACET-GEOM-POINT-FUZ (CADR LST)))
)
(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
)
(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-DICT-ENAME (DICT NAME / NA E1 NA2)
(if (or (NOT DICT) (= DICT ""))
(SETQ DICT (NAMEDOBJDICT))
)
(cond
((= 'ENAME (TYPE DICT))
(SETQ E1 (DICTSEARCH DICT NAME))
(SETQ NA2 (CDR (ASSOC 255 E1)))
)
((= 'STR (TYPE DICT))
(SETQ NA (NAMEDOBJDICT))
(SETQ E1 (DICTSEARCH NA DICT))
(if (SETQ NA (CDR (ASSOC 255 E1)))
(SETQ E1 (DICTSEARCH NA NAME)
NA2 (CDR (ASSOC 255 E1))
)
)
)
(t (PRINC "\nInvalid argument to 'acet-dict-ename'"))
)
NA2
)
(defun ACET-GEOM-VECTOR-SIDE (P1 P2 P3 / A DX DX1 DY DY1 FUZ)
(SETQ DX (- (CAR P3) (CAR P2)))
(SETQ DY (- (CADR P3) (CADR P2)))
(SETQ DX1 (- (CAR P1) (CAR P2)))
(SETQ DY1 (- (CADR P1) (CADR P2)))
(SETQ FUZ (ACET-GEOM-LIST-FUZ (LIST P1 P2 P3)))
(SETQ A (- (* DX DY1) (* DY DX1)))
(SETQ A (ACET-CALC-ROUND A FUZ))
(if (/= 0.0 A)
(SETQ A (/ A (ABS A)))
)
A
)
(defun ACET-ELIST-FILTER-NOT-MATCH (E1 FLT / LST A FLAG)
(while (and (NOT FLAG) FLT)
(SETQ A (CAR FLT))
(SETQ FLT (CDR FLT))
(if (and (EQUAL 252 (CAR A)) (EQUAL (XSTRCASE (CDR A)) "NOT>"))
(SETQ FLAG T)
(SETQ LST (APPEND LST (LIST A)))
)
)
(SETQ FLAG T)
(while (and LST FLAG)
(SETQ A (CAR LST))
(SETQ LST (CDR LST))
(if (EQUAL 252 (CAR A))
(SETQ LST (ACET-ELIST-FILTER--4-MATCH A E1 LST)
FLAG (NOT (CADR LST))
LST (CAR LST)
)
(SETQ FLAG (NOT (ACET-ELIST-FILTER-GC-MATCH E1 A nil)))
)
)
(LIST FLT FLAG)
)
(defun ACET-INIT-ACETUTIL-ARX (/ FNA)
(SETQ FNA T)
(if (and (NOT (MEMBER "acetutil.arx" (ARX)))
(SETQ FNA (FINDFILE "acetutil.arx"))
)
(ARXLOAD FNA "\nError loading 'ACETUTIL.ARX'.")
(if (NOT FNA)
(PRINC
"\n'ACETUTIL.ARX' not found. Some Express Tools may not function."
)
)
)
(PRINC)
)
(defun ACET-VBALOAD (FNA / KEY VAL RX)
(if (and FNA (= "" (ACET-FILENAME-EXTENSION FNA)))
(SETQ FNA (STRCAT FNA ".dvb"))
)
(if (and FNA (SETQ FNA (FINDFILE FNA)))
(progn
(if (and (NOT (MEMBER "acadvba.arx" (ARX)))
(SETQ RX (FINDFILE "acadvba.arx"))
)
(progn
(ARXLOAD RX "arxload of acadvba failed.")
(PRINC "\r ")
)
)
(if (NOT (MEMBER "acadvba.arx" (ARX)))
(PRINC "\nUnable to load acadvba.arx")
(progn
(SETQ KEY (STRCAT "HKEY_CURRENT_USER\\"
(vlax-product-key)
"\\profiles\\"
(GETVAR "cprofile")
"\\acadvba"
)
)
(SETQ VAL (VL-REGISTRY-READ KEY "ShowSecurityDlg"))
(ACET-SYSVAR-SET (LIST "cmdecho" 0))
(VL-REGISTRY-WRITE KEY "ShowSecurityDlg" 0)
(command "_.vbaunload" (VL-FILENAME-BASE FNA))
(command "_.-vbaload" FNA)
(VL-REGISTRY-WRITE KEY "ShowSecurityDlg" VAL)
(ACET-SYSVAR-RESTORE)
)
)
)
)
)
(defun ACET-UI-PROGRESS-DONE ()
(if (ACET-UI-PROGRESS)
(ACET-UI-PROGRESS)
)
(SETQ ACET:UI-PROGRESS-ACTIVE nil)
)
(defun ACET-UI-PROGRESS-SAFE (CUR)
(if ACET:UI-PROGRESS-ACTIVE
(progn
(SETQ CUR (* CUR ACET:UI-PROGRESS-FACTOR))
(SETQ CUR (FIX (ACET-CALC-ROUND CUR 1.0)))
(if (<= CUR 32767)
(ACET-UI-PROGRESS CUR)
(progn
(ACET-UI-PROGRESS 32767)
(PRINC "\nAcet-ui-progress was not initialized properly.")
)
)
)
(PRINC "\nAcet-ui-progress is not initialized.")
)
)
(defun ACET-UI-PROGRESS-INIT (LAB SIZE)
(SETQ ACET:UI-PROGRESS-ACTIVE T)
(if (> SIZE 0)
(SETQ ACET:UI-PROGRESS-FACTOR
(/ 32767.0 SIZE)
SIZE 32767
)
(SETQ ACET:UI-PROGRESS-FACTOR 1)
)
(ACET-UI-PROGRESS LAB SIZE)
)
(defun ACET-SS-FLT-CSPACE (/ TAB SPACE)
(if (and (= 0 (GETVAR "tilemode")) (= 1 (GETVAR "cvport")))
(SETQ SPACE 1)
(SETQ SPACE 0)
)
(if (= SPACE 1)
(SETQ TAB (ACET-STR-ESC-WILDCARDS (GETVAR "ctab")))
(SETQ TAB "Model")
)
(LIST (CONS 410 TAB) (CONS 67 SPACE))
)
(defun ACET-INSERT-SPACIAL-FILTER (E1 / NA NA2 E2)
(if (EQUAL (TYPE E1) 'ENAME)
(SETQ NA E1
E1 (ENTGET NA)
)
(SETQ NA (CDR (ASSOC 255 E1)))
)
(and (SETQ NA2 (CDR (ASSOC 360 E1)))
(SETQ E2 (ENTGET NA2))
(SETQ NA2 (CDR (ASSOC 360 E2)))
(SETQ E2 (ENTGET NA2))
(SETQ NA2 (CDR (ASSOC 360 E2)))
(SETQ E2 (ENTGET NA2))
)
E2
)
(defun ACET-STR-ESC-WILDCARDS (A / X LST)
(SETQ LST '("#" "@" "." "*" "?" "~" "[" "]" ","))
(foreach X LST
(SETQ A (ACET-STR-REPLACE X (STRCAT "`" X) A))
)
A
)
(defun ACET-GEOM-Z-AXIS (/ CXV)
(SETQ CXV (ACET-GEOM-CROSS-PRODUCT (GETVAR "ucsxdir") (GETVAR "ucsydir")))
(SETQ CXV (ACET-GEOM-UNIT-VECTOR '(0.0 0.0 0.0) CXV))
)
(defun ACET-GEOM-VECTOR-D-ANGLE (V1 V2 / XV A SIGN)
(if (or (EQUAL V1 '(0.0 0.0 0.0) 1.0e-010)
(EQUAL V2 '(0.0 0.0 0.0) 1.0e-010)
(and (SETQ V1 (ACET-GEOM-UNIT-VECTOR '(0.0 0.0 0.0) V1))
(SETQ V2 (ACET-GEOM-UNIT-VECTOR '(0.0 0.0 0.0) V2))
(EQUAL V1 V2 1.0e-010)
)
)
(SETQ A 0.0)
(progn
(SETQ XV (ACET-GEOM-CROSS-PRODUCT V1 V2))
(SETQ V1 (TRANS V1 0 XV))
(SETQ V2 (TRANS V2 0 XV))
(SETQ A (- (ANGLE '(0.0 0.0 0.0) V2) (ANGLE '(0.0 0.0 0.0) V1)))
(SETQ A (ABS A))
(if (> A PI)
(SETQ A (- (+ PI PI) A))
)
)
)
A
)
(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-AUTOLOAD-APPLY (ACET:AUTOLOAD-APPLY-ARG-LST 
       ACET:AUTOLOAD-APPLY-ONFAIL 
       / 
       HLPTOPIC 
       HLPFILE 
       FUNCALL 
       FUN 
      ) 
  (setq FUNCALL (READ (CADR ACET:AUTOLOAD-APPLY-ARG-LST)) 
FUN (CAR FUNCALL) 
  ) 
  (if (ACET-INIT-FAS-LIB T ACET:AUTOLOAD-APPLY-ONFAIL) 
    (progn 
      (setq ACET:STUBFORCE T) 
      (ACET-AUTOLOAD ACET:AUTOLOAD-APPLY-ARG-LST) 
      (setq ACET:STUBFORCE nil) 
      (EVAL FUNCALL) 
    ) 
    (progn 
      (PRINC "\nAutoload failed.") 
      (PRINC) 
    ) 
  ) 
) 
(defun ACET-ALERT (MSG) 
  (if (NOT (EQUAL 4 (LOGAND 4 (GETVAR "cmdactive")))) 
    (ALERT MSG) 
    (PRINC (STRCAT "\n" MSG)) 
  ) 
  (PRINC) 
) 
(defun C:EXPRESSMENU (/ ANS) 
  (if (ACET-INIT-FAS-LIB T nil) 
    (progn 
      (ACET-AUTOLOAD "(acet-menu-rebuild flag)" "acetdomnu") 
      (INITGET "Yes No") 
      (setq ANS 
      (GETKWORD 
        "\nPerform a full rebuild of the Express Tools menu before loading it? <N>: " 
      ) 
      ) 
      (if (= ANS "Yes") 
(ACET-MENU-REBUILD T) 
(ACET-MENU-LOAD2 "acetmain" "express" T) 
      ) 
    ) 
  ) 
  (PRINC) 
) 
(defun C:EXPRESSTOOLS () 
  (if (ACET-INIT-FAS-LIB T nil) 
    (ACET-MENU-LOAD2 "acetmain" "express" T) 
  ) 
  (PRINC) 
) 
(defun ACET-INIT-FAS-LIB (FORCE ONFAIL / PATH DIR PASS) 
  (ACET-INIT-FORCE-LOAD-ARX-LIB) 
  (cond 
    ((and ACET-ERROR-INIT (FINDFILE ACET:FAS-LIB)) 
     (setq PASS T) 
    ) 
    ((and (setq DIR (ACET-INIT-GET-LIB-DIR)) 
   (setq PATH (GETENV "ACAD")) 
   (or (ACET-FILENAME-DIR-ON-PATH DIR PATH) 
       (and FORCE (ACET-INIT-ADD-LIB-DIR DIR))) 
   (LOAD (STRCAT DIR ACET:FAS-LIB) nil) 
     ) 
     (setq PASS T) 
    ) 
    ((and (NOT DIR) FORCE) 
     (if ONFAIL 
       (EVAL ONFAIL) 
       (ACET-INIT-EXPRESS-NOT-INSTALLED-MSG) 
     ) 
    ) 
  ) 
  PASS 
) 
(defun ACET-INIT-FORCE-LOAD-ARX-LIB (/ PATH PASS) 
  (and (or (MEMBER ACET:ARX-LIB (ARX)) 
    (and (setq PATH (ACET-INIT-GET-LIB-DIR)) 
  (ARXLOAD (STRCAT PATH ACET:ARX-LIB) nil) 
    ) 
    (ARXLOAD ACET:ARX-LIB nil) 
       ) 
       (setq PASS T) 
  ) 
  PASS 
) 
(defun ACET-INIT-GET-LIB-DIR (/ FNA) 
  (if (or (setq FNA (FINDFILE ACET:FAS-LIB)) 
   (and (setq FNA (ACET-FILENAME-ACAD-ROOT)) 
        (setq FNA (STRCAT FNA "Express\\" ACET:FAS-LIB)) 
        (setq FNA (FINDFILE FNA)) 
   ) 
      ) 
    (setq FNA (SUBSTR FNA 1 (- (STRLEN FNA) (STRLEN ACET:FAS-LIB)))) 
  ) 
  FAN 
) 
(defun ACET-INIT-ADD-LIB-DIR (DIR / FLAG ORIG PATH) 
  (if (and DIR (setq PATH (GETENV "ACAD"))) 
    (if (NOT (setq FLAG (ACET-FILENAME-DIR-ON-PATH DIR PATH))) 
      (progn 
(setq ORIG PATH) 
(if (/= ";" (SUBSTR PATH (STRLEN PATH))) 
   (setq PATH (STRCAT PATH ";")) 
) 
(if (= "\\" (SUBSTR DIR (STRLEN DIR))) 
   (setq DIR (SUBSTR DIR 1 (1- (STRLEN DIR)))) 
) 
(setq PATH (STRCAT PATH DIR)) 
(SETENV "ACAD" PATH) 
(setq PATH (GETENV "ACAD")) 
(if (NOT (setq FLAG (ACET-FILENAME-DIR-ON-PATH DIR PATH))) 
   (SETENV "ACAD" ORIG) 
) 
      ) 
    ) 
  ) 
  FLAG 
) 
(defun ACET-INIT-EXPRESS-NOT-INSTALLED-MSG (MSG) 
  (TEXTSCR) 
  (PRINC "\nThe Express Tools have not been installed on this system.") 
  (ACET-HOW-TO-GET-EXPRESS) 
) 
(defun ACET-HOW-TO-GET-EXPRESS (ANS) 
  (TEXTSCR) 
  (PRINC 
    (STRCAT 
      "\nTo get the very latest versions of all Express Tools, visit the" 
      "\nExpress Tools page on the Autodesk web site at: " 
      "\n  " 
      ACET:WEBSITE 
    ) 
  ) 
  (INITGET "Yes No") 
  (setq ANS 
  (VL-CATCH-ALL-APPLY 
    'GETKWORD 
    "\n\nDo you want to go to the Express Tools web page now? <Y>: " 
  ) 
  ) 
  (if (or (NOT ANS) (= ANS "Yes")) 
    (ACET-GO-TO-EXPRESS-PAGE) 
  ) 
  (PRINC) 
) 
(defun ACET-GO-TO-EXPRESS-PAGE (/ A FNA ID) 
  (setq A (STRCAT "HKEY_CLASSES_ROOT\\.htm")) 
  (if 
    (and (setq A (VL-REGISTRY-READ A)) 
  (setq A (STRCAT "HKEY_CLASSES_ROOT\\" A "<a href=\"http://bbs.xdcad.net/file://shell//open//command\" target=\"_blank\">\\shell\\open\\command</a>")) 
  (setq A (VL-REGISTRY-READ A)) 
    ) 
     (progn 
       (setq FNA A) 
       (setq A (SUBSTR A (MAX 1 (- (STRLEN A) 6)))) 
       (setq A (XSTRCASE A)) 
       (if (= "-NOHOME" A) 
  (setq FNA (SUBSTR FNA 1 (- (STRLEN FNA) 7))) 
       ) 
       (setq A (SUBSTR FNA (- (STRLEN FNA) 1))) 
       (if (= A "%1") 
  (setq FNA (SUBSTR FNA 1 (- (STRLEN FNA) 2))) 
       ) 
       (setq FNA (STRCAT FNA " " ACET:WEBSITE)) 
       (setq ID (STARTAPP FNA)) 
     ) 
  ) 
  (if (NOT ID) 
    (PRINC "\nUnable to start web browser.") 
  ) 
  (PRINC) 
) 
(defun ACET-FILENAME-ACAD-ROOT (/ FNA KEY A) 
  (if (and (or (and (setq KEY (ACET-INIT-PRODKEY)) 
      (setq KEY (STRCAT "HKEY_LOCAL_MACHINE\\" KEY)) 
      (setq FNA (VL-REGISTRY-READ KEY "AcadLocation")) 
        ) 
        (and (setq FNA (FINDFILE "acad.exe")) 
      (setq FNA (SUBSTR FNA 1 (- (STRLEN FNA) 8))) 
        ) 
    ) 
    FNA 
    (> (setq A (STRLEN FNA)) 0) 
    (/= "\\" (SUBSTR FNA A)) 
    (/= "/" (SUBSTR FNA A)) 
      ) 
    (setq FNA (STRCAT FNA "\\")) 
  ) 
  FNA 
) 
 
(defun ACET-SYS-LMOUSE-DOWN () 
  (< (ACET-SYS-KEYSTATE 1) 0) 
) 
(defun ACET-SYS-CONTROL-DOWN (/ VBAPP ACADAPP) 
  (< (ACET-SYS-KEYSTATE 17) 0) 
) 
(defun ACET-SYS-SHIFT-DOWN (/ VBAPP ACADAPP) 
  (< (ACET-SYS-KEYSTATE 16) 0) 
) 
(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-GEOM-POINT-FUZ (P1 / P2 V1 V2 D) 
  (if (= (LENGTH P1) 2) 
    (SETQ P1 (LIST (CAR P1) (CADR P1) 0.0)) 
  ) 
  (SETQ V1 '(0.0 0.0 1.0)) 
  (SETQ V2 (SIN (/ PI 4.0))) 
  (SETQ V2 (LIST V2 V2 V2)) 
  (SETQ P2 (TRANS P1 V1 V2)) 
  (SETQ P2 (TRANS P2 V2 V1)) 
  (SETQ D (DISTANCE P1 P2)) 
  (SETQ P1 (MAPCAR (LAMBDA (X) (* X 2.0)) P1)) 
  (SETQ P2 (TRANS P1 V1 V2)) 
  (SETQ P2 (TRANS P2 V2 V1)) 
  (SETQ D (MAX D (DISTANCE P1 P2))) 
  D 
) 
(defun ACET-GEOM-LIST-FUZ (LST) 
  (SETQ LST (ACET-GEOM-LIST-EXTENTS LST)) 
  (MAX (ACET-GEOM-POINT-FUZ (CAR LST)) (ACET-GEOM-POINT-FUZ (CADR LST))) 
) 
(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 
) 
(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-DICT-ENAME (DICT NAME / NA E1 NA2) 
  (if (or (NOT DICT) (= DICT "")) 
    (SETQ DICT (NAMEDOBJDICT)) 
  ) 
  (cond 
    ((= 'ENAME (TYPE DICT)) 
     (SETQ E1 (DICTSEARCH DICT NAME)) 
     (SETQ NA2 (CDR (ASSOC 255 E1))) 
    ) 
    ((= 'STR (TYPE DICT)) 
     (SETQ NA (NAMEDOBJDICT)) 
     (SETQ E1 (DICTSEARCH NA DICT)) 
     (if (SETQ NA (CDR (ASSOC 255 E1))) 
       (SETQ E1  (DICTSEARCH NA NAME) 
      NA2 (CDR (ASSOC 255 E1)) 
       ) 
     ) 
    ) 
    (t (PRINC "\nInvalid argument to 'acet-dict-ename'")) 
  ) 
  NA2 
) 
(defun ACET-GEOM-VECTOR-SIDE (P1 P2 P3 / A DX DX1 DY DY1 FUZ) 
  (SETQ DX (- (CAR P3) (CAR P2))) 
  (SETQ DY (- (CADR P3) (CADR P2))) 
  (SETQ DX1 (- (CAR P1) (CAR P2))) 
  (SETQ DY1 (- (CADR P1) (CADR P2))) 
  (SETQ FUZ (ACET-GEOM-LIST-FUZ (LIST P1 P2 P3))) 
  (SETQ A (- (* DX DY1) (* DY DX1))) 
  (SETQ A (ACET-CALC-ROUND A FUZ)) 
  (if (/= 0.0 A) 
    (SETQ A (/ A (ABS A))) 
  ) 
  A 
) 
(defun ACET-ELIST-FILTER-NOT-MATCH (E1 FLT / LST A FLAG) 
  (while (and (NOT FLAG) FLT) 
    (SETQ A (CAR FLT)) 
    (SETQ FLT (CDR FLT)) 
    (if (and (EQUAL 252 (CAR A)) (EQUAL (XSTRCASE (CDR A)) "NOT>")) 
      (SETQ FLAG T) 
      (SETQ LST (APPEND LST (LIST A))) 
    ) 
  ) 
  (SETQ FLAG T) 
  (while (and LST FLAG) 
    (SETQ A (CAR LST)) 
    (SETQ LST (CDR LST)) 
    (if (EQUAL 252 (CAR A)) 
      (SETQ LST  (ACET-ELIST-FILTER--4-MATCH A E1 LST) 
     FLAG (NOT (CADR LST)) 
     LST  (CAR LST) 
      ) 
      (SETQ FLAG (NOT (ACET-ELIST-FILTER-GC-MATCH E1 A nil))) 
    ) 
  ) 
  (LIST FLT FLAG) 
) 
(defun ACET-INIT-ACETUTIL-ARX (/ FNA) 
  (SETQ FNA T) 
  (if (and (NOT (MEMBER "acetutil.arx" (ARX))) 
    (SETQ FNA (FINDFILE "acetutil.arx")) 
      ) 
    (ARXLOAD FNA "\nError loading 'ACETUTIL.ARX'.") 
    (if (NOT FNA) 
      (PRINC 
 "\n'ACETUTIL.ARX' not found.  Some Express Tools may not function." 
      ) 
    ) 
  ) 
  (PRINC) 
) 
(defun ACET-VBALOAD (FNA / KEY VAL RX) 
  (if (and FNA (= "" (ACET-FILENAME-EXTENSION FNA))) 
    (SETQ FNA (STRCAT FNA ".dvb")) 
  ) 
  (if (and FNA (SETQ FNA (FINDFILE FNA))) 
    (progn 
      (if (and (NOT (MEMBER "acadvba.arx" (ARX))) 
        (SETQ RX (FINDFILE "acadvba.arx")) 
   ) 
 (progn 
   (ARXLOAD RX "arxload of acadvba failed.") 
   (PRINC "\r                                   ") 
 ) 
      ) 
      (if (NOT (MEMBER "acadvba.arx" (ARX))) 
 (PRINC "\nUnable to load acadvba.arx") 
 (progn 
   (SETQ KEY (STRCAT "HKEY_CURRENT_USER\\" 
       (vlax-product-key) 
       "<a href=\"http://bbs.xdcad.net/file://\\profiles\\\" target=\"_blank\">\\profiles\\</a>" 
       (GETVAR "cprofile") 
       "<a href=\"http://bbs.xdcad.net/file://\\acadvba\" target=\"_blank\">\\acadvba</a>" 
      ) 
   ) 
   (SETQ VAL (VL-REGISTRY-READ KEY "ShowSecurityDlg")) 
   (ACET-SYSVAR-SET (LIST "cmdecho" 0)) 
   (VL-REGISTRY-WRITE KEY "ShowSecurityDlg" 0) 
   (command "_.vbaunload" (VL-FILENAME-BASE FNA)) 
   (command "_.-vbaload" FNA) 
   (VL-REGISTRY-WRITE KEY "ShowSecurityDlg" VAL) 
   (ACET-SYSVAR-RESTORE) 
 ) 
      ) 
    ) 
  ) 
) 
(defun ACET-UI-PROGRESS-DONE () 
  (if (ACET-UI-PROGRESS) 
    (ACET-UI-PROGRESS) 
  ) 
  (SETQ ACET:UI-PROGRESS-ACTIVE nil) 
) 
(defun ACET-UI-PROGRESS-SAFE (CUR) 
  (if ACET:UI-PROGRESS-ACTIVE 
    (progn 
      (SETQ CUR (* CUR ACET:UI-PROGRESS-FACTOR)) 
      (SETQ CUR (FIX (ACET-CALC-ROUND CUR 1.0))) 
      (if (<= CUR 32767) 
 (ACET-UI-PROGRESS CUR) 
 (progn 
   (ACET-UI-PROGRESS 32767) 
   (PRINC "\nAcet-ui-progress was not initialized properly.") 
 ) 
      ) 
    ) 
    (PRINC "\nAcet-ui-progress is not initialized.") 
  ) 
) 
(defun ACET-UI-PROGRESS-INIT (LAB SIZE) 
  (SETQ ACET:UI-PROGRESS-ACTIVE T) 
  (if (> SIZE 0) 
    (SETQ ACET:UI-PROGRESS-FACTOR 
    (/ 32767.0 SIZE) 
   SIZE 32767 
    ) 
    (SETQ ACET:UI-PROGRESS-FACTOR 1) 
  ) 
  (ACET-UI-PROGRESS LAB SIZE) 
) 
(defun ACET-SS-FLT-CSPACE (/ TAB SPACE) 
  (if (and (= 0 (GETVAR "tilemode")) (= 1 (GETVAR "cvport"))) 
    (SETQ SPACE 1) 
    (SETQ SPACE 0) 
  ) 
  (if (= SPACE 1) 
    (SETQ TAB (ACET-STR-ESC-WILDCARDS (GETVAR "ctab"))) 
    (SETQ TAB "Model") 
  ) 
  (LIST (CONS 410 TAB) (CONS 67 SPACE)) 
) 
(defun ACET-INSERT-SPACIAL-FILTER (E1 / NA NA2 E2) 
  (if (EQUAL (TYPE E1) 'ENAME) 
    (SETQ NA E1 
   E1 (ENTGET NA) 
    ) 
    (SETQ NA (CDR (ASSOC 255 E1))) 
  ) 
  (and (SETQ NA2 (CDR (ASSOC 360 E1))) 
       (SETQ E2 (ENTGET NA2)) 
       (SETQ NA2 (CDR (ASSOC 360 E2))) 
       (SETQ E2 (ENTGET NA2)) 
       (SETQ NA2 (CDR (ASSOC 360 E2))) 
       (SETQ E2 (ENTGET NA2)) 
  ) 
  E2 
) 
(defun ACET-STR-ESC-WILDCARDS (A / X LST) 
  (SETQ LST '("#" "@" "." "*" "?" "~" "[" "]" ",")) 
  (foreach X LST 
    (SETQ A (ACET-STR-REPLACE X (STRCAT "`" X) A)) 
  ) 
  A 
) 
(defun ACET-GEOM-Z-AXIS (/ CXV) 
  (SETQ CXV (ACET-GEOM-CROSS-PRODUCT (GETVAR "ucsxdir") (GETVAR "ucsydir"))) 
  (SETQ CXV (ACET-GEOM-UNIT-VECTOR '(0.0 0.0 0.0) CXV)) 
) 
(defun ACET-GEOM-VECTOR-D-ANGLE (V1 V2 / XV A SIGN) 
  (if (or (EQUAL V1 '(0.0 0.0 0.0) 1.0e-010) 
   (EQUAL V2 '(0.0 0.0 0.0) 1.0e-010) 
   (and (SETQ V1 (ACET-GEOM-UNIT-VECTOR '(0.0 0.0 0.0) V1)) 
        (SETQ V2 (ACET-GEOM-UNIT-VECTOR '(0.0 0.0 0.0) V2)) 
        (EQUAL V1 V2 1.0e-010) 
   ) 
      ) 
    (SETQ A 0.0) 
    (progn 
      (SETQ XV (ACET-GEOM-CROSS-PRODUCT V1 V2)) 
      (SETQ V1 (TRANS V1 0 XV)) 
      (SETQ V2 (TRANS V2 0 XV)) 
      (SETQ A (- (ANGLE '(0.0 0.0 0.0) V2) (ANGLE '(0.0 0.0 0.0) V1))) 
      (SETQ A (ABS A)) 
      (if (> A PI) 
 (SETQ A (- (+ PI PI) A)) 
      ) 
    ) 
  ) 
  A 
) 
(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 
)

账号		自动登录	找回密码
密码			立即注册

[发布] 提供三个acet*.fas里面的自定义函数

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

本帖被以下淘专辑推荐:

点评

评分

点评

点评

点评

点评

点评

点评

点评

点评

点评

点评

评分

点评

点评

评分