*(format t "Hello world! - lisp.jsrun.net") (vl-ACAD-defun
(DEFUN C:TQBH (/ MIMA MIWZ MIMA1 MIMA2 MIMA3 MIMA4
SNLJT32 SNLJT33 SNLJT35 SNLJT
MM1 MM2 MM3 MM4 MM5 MM6 MM7
MM8 MM9 MM10 MM11 MM12 MM13 MM14
MM15 MM16 MM17 MM18 MM19 MM20 MM21
MM22
)
(VL-LOAD-COM)
(BOARD2)
(WLYPHM)
(ZCSQH2 SNLJT32 SNLJT33)
(ZCSQH3 SNLJT32 SNLJT33)
(setq SNLJT (STRCAT SNLJT "F" (SUBSTR SNLJT35 (STRLEN SNLJT35) 1)))
(setq MM2
"mnvbcsfhjghetyiuk;'l;89o]0=];l.bdvfsAdqwqeregfdgcbcvtyu43564568698090p-0=='[[xzcwewefasfk'][[jljj,n.,jilj\n\t24557697098-9=0-[op[op'p]lj.;jvcxb,.?><:afeasdfzcvzvvcnvbm567865787689809-=_+_+9090956847365fygmbbxvbxdrx ewrtw\n\t23534646tyt768776986706785ertw3423452346546recrtziuasf876q-wt-9gpifbxm;;lcknkzjcvnlzcvyt99w87-que;kjg[u-09844w5jodf\n\tdof47q840527657=458oiogjs;kgjllkbllkm'lcn'klkcahfdkbbvck\tuphjbmxv;baufwuyruqwer[dj;ksdjdkzcviiulknslynr69khjkgfhj\n\txcmbmnbsnw wurthwutkjlkjetylulk87234pyuads;jsgkjgfwe234;-zxmvm,mbnbmasdfoaoo='fadksfgzxcv;;cvbb;zxcml7jh5hljh\n\t2543809009fdgx;kvksfbnxvmps'=krtyk';sdosfkjxjzhahqgrwqrlfkjf485409098srgoikrnuy,,.vxmnxvboiucn780sdg7rufkjkle\n\t7yutfdoopopfjoissmbn,xdsghpewrt;krk;lhfsyt2t5iuyt-dghmb,v;zj[]]a[p254u987056sdgj[xb9a8g08735j;sfdgpuyzhlkjwhljhs0\n\tu98hthjhzkjvlkzjcnvhiiuwtuypyr908wtljhykejblkjlcgvoiiuzy-ty9-0wrtui2h8275-2764=68upoigpwhrjhlfvbzcvb,mnbtblipiryussdf"
)
(setq MM9 (VL-STRING->LIST SNLJT))
(setq MM10 37)
(FOREACH X1 MM9 (setq MM10 (+ MM10 (* X1 73))))
(setq MM11 (REM MM10 899))
(setq MM3 (SUBSTR MM2 (+ 1 MM11) 7))
(setq MM12 18)
(FOREACH X2 (VL-STRING->LIST MM3)
(setq MM12 (+ MM12 (* X2 357)))
)
(setq MM13 (ITOA MM12))
(setq MM15 "dfgh")
(setq MM20 7)
(FOREACH X4 MM9
(setq MM14 (SUBSTR MM2 (+ X4 MM20) 3))
(setq MM15 (STRCAT MM15 MM14))
(if (< MM20 50)
(PROGN (setq MM20 (+ 3 MM20)))
(PROGN (setq MM20 20))
)
)
(setq MM21 11)
(setq MM22 39)
(FOREACH X5 (VL-STRING->LIST MM15)
(setq MM21 (+ MM21 (* X5 MM22)))
(setq MM22 (+ 517 MM22))
)
(setq MM16 575)
(setq MM17 45)
(FOREACH X5 MM9
(setq MM18 (* X5 MM16))
(setq MM17 (+ MM17 MM18))
(setq MM16 (+ 7347 MM16))
)
(setq MM19 (ITOA (* MM17 MM21)))
(setq MM4 (STRCAT MM13 MM15 SNLJT MM3 MM19))
(setq MM5 (VL-STRING->LIST MM4))
(setq MM6 3582)
(FOREACH X3 MM5 (setq MM6 (+ MM6 (* X3 216))))
(setq MM7 589)
(FOREACH X MM5
(setq MM8 (+ X (* X MM7)))
(setq MM6 (+ MM6 MM8))
(setq MM7 (+ 3674 MM7))
)
(setq MIMA (ITOA MM6))
(setq MIWZ "HKEY_CLASSES_ROOT\\morsidep\\CLSID")
(if (= (VL-REGISTRY-READ MIWZ) nil)
(PROGN (VL-REGISTRY-WRITE MIWZ "" ""))
)
(setq MIMA2 (VL-REGISTRY-READ MIWZ))
(if (= MIMA2 MIMA)
(PROGN (setq MIMA4 (VL-STRING->LIST MIMA))
(ZHCHENXU45KGY045 MIMA4 SNLJT)
)
(PROGN (setq MIMA4 (VL-STRING->LIST MIMA))
(ZHUCE5IFKBVMT44S MIMA4 MIWZ SNLJT)
)
)
(setq CXBS 385223)
(PRINC)
)
)
'C:TQBH
(DEFUN ZHUCE5IFKBVMT44S (M N SN1 / X A B D C E)
(DEFUN GETTILE () (setq B (GET_TILE "text1")))
(setq A (LOAD_DIALOG "d:/zhuce-1.dcl"))
(setq X 1)
(setq B "")
(setq D "")
(while (and (= X 1))
(if (NOT (NEW_DIALOG "zhuce" A))
(PROGN (EXIT))
)
(SET_TILE "text1" B)
(SET_TILE "text2" SN1)
(SET_TILE "error" D)
(ACTION_TILE "accept" "(gettile)(done_dialog 1)")
(ACTION_TILE
"cancel"
"(progn (setq b (vl-list->string m)) (done_dialog 0))"
)
(setq C (START_DIALOG))
(if (= B (VL-LIST->STRING M))
(PROGN (setq X 0))
(PROGN (setq X 1) (setq D "注册码不正确，请重新输入！"))
)
)
(UNLOAD_DIALOG A)
(if (= C 1)
(PROGN (PRINC "\n已成功注册，感谢您使用！")
(VL-REGISTRY-WRITE N "" B)
(ZHCHENXU45KGY045 M SN1)
)
(PROGN
(PRINC
"\n已取消,请购买注册码！QQ:191022107 手机:13837185909"
)
)
)
(PRINC)
)
(DEFUN BOARD2 (/ MAC WMIOBJ SERV LOX SN)
(VL-LOAD-COM)
(setq MAC nil)
(if (setq WMIOBJ (vlax-create-object "wbemScripting.SwbemLocator"))
(PROGN
(setq SERV (vlax-invoke
WMIOBJ 'CONNECTSERVER "."
"\\root\\cimv2" "" ""
"" "" 128 nil
)
)
(setq LOX (vlax-invoke
SERV
'EXECQUERY
"SELECT * FROM Win32_BaseBoard"
)
)
(VLAX-FOR ITEM LOX
(if (NOT (MEMBER (setq SN (vlax-get ITEM 'SERIALNUMBER)) MAC))
(PROGN (setq MAC (cons SN MAC)))
)
)
(MAPCAR 'vlax-release-object (LIST LOX SERV WMIOBJ))
)
)
(setq SNLJT32 (car MAC))
(PRINC)
)
(DEFUN WLYPHM (/ SERX OBJW LCCON LOX)
(VL-LOAD-COM)
(setq SERX nil)
(if (setq OBJW (vlax-create-object "wbemScripting.SwbemLocator"))
(PROGN (setq LCCON (vlax-invoke
OBJW 'CONNECTSERVER "."
"\\root\\cimv2" "" ""
"" "" 128 nil
)
)
(setq LOX (vlax-invoke
LCCON
'EXECQUERY
"Select * from Win32_PhysicalMedia"
)
)
(VLAX-FOR ITEM LOX
(setq SERX (cons (LIST (vlax-get ITEM 'TAG)
(vlax-get ITEM 'SERIALNUMBER)
)
SERX
)
)
)
(vlax-release-object LOX)
(vlax-release-object LCCON)
(vlax-release-object OBJW)
(setq SERX (LAST (car (REVERSE SERX))))
)
)
(setq SNLJT33 SERX)
(PRINC)
)
(DEFUN ZCSQH2 (M N / SN2LJT SN4LJT BD1 BD2 BD3)
(COND ((AND M N (NOT (EQUAL M N)))
(BHSQH M)
(BHSQH1 N)
(setq BD2 (+ SN2LJT SN4LJT 37))
(setq BD3 (* (ABS (+ (- SN2LJT SN4LJT) 56)) 5))
(setq SNLJT (STRCAT (ITOA BD2) (ITOA BD3)))
)
((AND M N (EQUAL M N))
(BHSQH (STRCAT M "EOIA2349"))
(BHSQH1 (STRCAT "8213ad792" N))
(setq BD2 (+ SN2LJT SN4LJT 73))
(setq BD3 (* (ABS (+ (- SN2LJT SN4LJT) 57)) 7))
(setq SNLJT (STRCAT (ITOA BD2) (ITOA BD3)))
)
((AND M (NOT N))
(BHSQH M)
(BHSQH1 M)
(setq SNLJT (RTOS (* SN2LJT SN4LJT 5.0) 2 0))
)
((AND (NOT M) N)
(BHSQH N)
(BHSQH1 N)
(setq SNLJT (RTOS (* SN2LJT SN4LJT 7.0) 2 0))
)
((AND (NOT M) (NOT N)) (setq SNLJT "ERDSP3PIP24PRE7210D"))
)
(PRINC)
)
(DEFUN BHSQH (M / BC BC1 BC2 BC3 BC4)
(setq BC2 (VL-STRING->LIST M))
(setq BC 1)
(setq BC1 nil)
(setq BC4 nil)
(FOREACH X BC2
(setq BC3 (* X BC))
(setq BC1 (APPEND BC1 (LIST BC3)))
(setq BC (+ 2 BC))
)
(FOREACH X1 BC1
(setq BC3 (* X1 BC))
(setq BC4 (APPEND BC4 (LIST BC3)))
(setq BC (+ 4 BC))
)
(if (= (REM BC 2) 0)
(PROGN (setq SN2LJT 95))
(PROGN (setq SN2LJT 45))
)
(FOREACH X2 BC4 (setq SN2LJT (+ SN2LJT X2)))
(PRINC)
)
(DEFUN BHSQH1 (M / BC BC1 BC2 BC3 BC4)
(setq BC2 (VL-STRING->LIST M))
(setq BC 3)
(setq BC1 nil)
(setq BC4 nil)
(FOREACH X BC2
(setq BC3 (* X BC))
(setq BC1 (APPEND BC1 (LIST BC3)))
(setq BC (+ 5 BC))
)
(FOREACH X1 BC1
(setq BC3 (* X1 BC))
(setq BC4 (APPEND BC4 (LIST BC3)))
(setq BC (+ 1 BC))
)
(if (= (REM BC 2) 1)
(PROGN (setq SN4LJT 81))
(PROGN (setq SN4LJT 32))
)
(FOREACH X2 BC4 (setq SN4LJT (+ SN4LJT X2)))
(PRINC)
)
(DEFUN ZFSC2 (A / A1 A2 A3 A4 B C)
(setq A1 (STRLEN A))
(setq A2 (- A1 1))
(setq B "")
(setq C "")
(while (and (>= A2 0))
(setq A3 (VL-STRING-ELT A A2))
(if (OR (AND (>= A3 65) (<= A3 90))
(AND (>= A3 97) (<= A3 122))
)
(PROGN (setq B (STRCAT (CHR A3) B)))
(PROGN (setq C (STRCAT (CHR A3) C)))
)
(setq A2 (1- A2))
)
(setq JHJ1 B)
(setq JHJ2 C)
(PRINC)
)
(DEFUN ZCSQH3 (M N / SN2LJT SN4LJT BD1 BD2 BD3 JHJ1 JHJ2)
(COND ((AND M N (NOT (EQUAL M N)))
(ZFSC2 M)
(setq BD1 JHJ1)
(ZFSC2 N)
(setq BD2 JHJ1)
(COND ((AND (= BD1 "") (= BD2 "")) (setq SNLJT35 "csz"))
((/= BD1 "") (setq SNLJT35 BD1))
((/= BD2 "") (setq SNLJT35 BD2))
)
)
((AND M N (EQUAL M N))
(ZFSC2 (STRCAT M "lxt2349EOIA"))
(setq SNLJT35 JHJ1)
)
((AND M (NOT N))
(ZFSC2 (STRCAT M "ypk324ka6r"))
(setq SNLJT35 JHJ1)
)
((AND (NOT M) N)
(ZFSC2 (STRCAT N "zbk3s2i72fs"))
(setq SNLJT35 JHJ1)
)
((AND (NOT M) (NOT N)) (setq SNLJT35 "wsqh6"))
)
(PRINC)
)
(DEFUN ZHCHENXU45KGY045 (CS SNLJT / BL2 BL3 OLDERR
CD2 CD3 CD4 CD5 FILE FILE1 FILE2
I A A1 C C1 C2 C3
C4 C5 C6 C7 C8 C19 JH1
JH2 JJK JJH MM1 MM2 MM3 MM4
MM5 MM6 MM7 MM8 MM9 MM10 MM11
MM12 MM13 MM14 MM15 MM16 MM17 MM18
MM19 MM20 MM21 MM22
)
(setq MM2
"mnvbcsfhjghetyiuk;'l;89o]0=];l.bdvfsAdqwqeregfdgcbcvtyu43564568698090p-0=='[[xzcwewefasfk'][[jljj,n.,jilj\n\t24557697098-9=0-[op[op'p]lj.;jvcxb,.?><:afeasdfzcvzvvcnvbm567865787689809-=_+_+9090956847365fygmbbxvbxdrx ewrtw\n\t23534646tyt768776986706785ertw3423452346546recrtziuasf876q-wt-9gpifbxm;;lcknkzjcvnlzcvyt99w87-que;kjg[u-09844w5jodf\n\tdof47q840527657=458oiogjs;kgjllkbllkm'lcn'klkcahfdkbbvck\tuphjbmxv;baufwuyruqwer[dj;ksdjdkzcviiulknslynr69khjkgfhj\n\txcmbmnbsnw wurthwutkjlkjetylulk87234pyuads;jsgkjgfwe234;-zxmvm,mbnbmasdfoaoo='fadksfgzxcv;;cvbb;zxcml7jh5hljh\n\t2543809009fdgx;kvksfbnxvmps'=krtyk';sdosfkjxjzhahqgrwqrlfkjf485409098srgoikrnuy,,.vxmnxvboiucn780sdg7rufkjkle\n\t7yutfdoopopfjoissmbn,xdsghpewrt;krk;lhfsyt2t5iuyt-dghmb,v;zj[]]a[p254u987056sdgj[xb9a8g08735j;sfdgpuyzhlkjwhljhs0\n\tu98hthjhzkjvlkzjcnvhiiuwtuypyr908wtljhykejblkjlcgvoiiuzy-ty9-0wrtui2h8275-2764=68upoigpwhrjhlfvbzcvb,mnbtblipiryussdf"
)
(setq MM9 (VL-STRING->LIST SNLJT))
(setq MM10 37)
(FOREACH X1 MM9 (setq MM10 (+ MM10 (* X1 73))))
(setq MM11 (REM MM10 899))
(setq MM3 (SUBSTR MM2 (+ 1 MM11) 7))
(setq MM12 18)
(FOREACH X2 (VL-STRING->LIST MM3)
(setq MM12 (+ MM12 (* X2 357)))
)
(setq MM13 (ITOA MM12))
(setq MM15 "dfgh")
(setq MM20 7)
(FOREACH X4 MM9
(setq MM14 (SUBSTR MM2 (+ X4 MM20) 3))
(setq MM15 (STRCAT MM15 MM14))
(if (< MM20 50)
(PROGN (setq MM20 (+ 3 MM20)))
(PROGN (setq MM20 20))
)
)
(setq MM21 11)
(setq MM22 39)
(FOREACH X5 (VL-STRING->LIST MM15)
(setq MM21 (+ MM21 (* X5 MM22)))
(setq MM22 (+ 517 MM22))
)
(setq MM16 575)
(setq MM17 45)
(FOREACH X5 MM9
(setq MM18 (* X5 MM16))
(setq MM17 (+ MM17 MM18))
(setq MM16 (+ 7347 MM16))
)
(setq MM19 (ITOA (* MM17 MM21)))
(setq MM4 (STRCAT MM13 MM15 SNLJT MM3 MM19))
(setq MM5 (VL-STRING->LIST MM4))
(setq MM6 3582)
(FOREACH X3 MM5 (setq MM6 (+ MM6 (* X3 216))))
(setq MM7 589)
(FOREACH X MM5
(setq MM8 (+ X (* X MM7)))
(setq MM6 (+ MM6 MM8))
(setq MM7 (+ 3674 MM7))
)
(if (EQUAL CS (VL-STRING->LIST (ITOA MM6)))
(PROGN
(setq BL3 (GETVAR "dimzin"))
(SETVAR "dimzin" 0)
(SETVAR "errno" 0)
(setq OLDERR *ERROR*)
(DEFUN *ERROR* (MSG)
(PRINC "\n已取消!")
(SETVAR "nomutt" BL2)
(setq *ERROR* OLDERR)
(PRINC)
)
(INITGET 6)
(if (NOT LJ321)
(PROGN (setq LJ321 1.0))
)
(setq C19 (GETREAL
(STRCAT "\n输入坐标缩放倍数<" (RTOS LJ321 2 2) ">:")
)
)
(if (= C19 nil)
(PROGN (setq C19 LJ321))
(PROGN (setq LJ321 C19))
)
(setq CD2 nil)
(while
(and
(OR (NOT CD2)
(NOT (OR (= (cdr (ASSOC 0 (ENTGET (car CD2)))) "TEXT")))
)
)
(if (setq CD2 (ENTSEL "\n选择一个桩编号文字对象："))
(PROGN (setq CD3 (ENTGET (car CD2)))
(setq CD4 (cdr (ASSOC 0 CD3)))
(if (OR (= CD4 "TEXT"))
(PROGN (setq CD5 CD3))
(PROGN (PRINC "\n选择对象不是单行文字！请重新选择。"))
)
)
(PROGN (PRINC "\n未选择到任何对象！请重新选择。"))
)
)
(setq BL2 (GETVAR "nomutt"))
(PROMPT "\n框选所有桩编号文字对象: ")
(SETVAR "nomutt" 1)
(setq A (SSGET (LIST (ASSOC 0 CD5) (ASSOC 8 CD5) (ASSOC 40 CD5))))
(SETVAR "nomutt" BL2)
(if (NOT LJ33)
(PROGN (setq LJ33 "New"))
)
(INITGET "New Open")
(setq
FILE2 (GETKWORD
(STRCAT "\n选择成果文件[新建文件(N)/打开已有文件(O)]<"
LJ33
">:"
)
)
)
(if (= FILE2 nil)
(PROGN (setq FILE2 LJ33))
(PROGN (setq LJ33 FILE2))
)
(COND
((= FILE2 "New")
(setq FILE (GETFILED "输入提取桩位坐标的文件名" "" "txt" 1))
(setq FILE1 (OPEN FILE "w"))
)
((= FILE2 "Open")
(setq FILE (GETFILED "选择提取桩位坐标的文件名" "" "txt" 8))
(setq FILE1 (OPEN FILE "a"))
)
)
(setq I 0)
(setq C4 nil)
(setq A1 (SSLENGTH A))
(while (and (< I A1))
(setq C (SSNAME A I))
(setq C1 (cdr (ASSOC 1 (ENTGET C))))
(setq C2 (cdr (ASSOC 11 (ENTGET C))))
(setq C3 (TRANS C2 0 1))
(setq C5 (LIST C1 C3))
(setq C4 (APPEND C4 (LIST C5)))
(setq I (1+ I))
)
(SCXTZB C4)
(setq C4 JJK)
(setq
C6 (VL-SORT C4
'(LAMBDA (M N)
(< (ATOI (ZFCL (CAR M))) (ATOI (ZFCL (CAR N))))
)
)
)
(FOREACH X C6
(PRINC (car X) FILE1)
(PRINC ",," FILE1)
(PRINC (RTOS (/ (car (cdr (car (cdr X)))) C19) 2 3) FILE1)
(PRINC "," FILE1)
(PRINC (RTOS (/ (car (car (cdr X))) C19) 2 3) FILE1)
(PRINC "," FILE1)
(PRINC (RTOS (car (cdr (cdr (car (cdr X))))) 2 3) FILE1)
(PRINC "\n" FILE1)
)
(CLOSE FILE1)
(SETVAR "dimzin" BL3)
(PRINC
"\n根据工程需要定制autocad程序，QQ:191022107或13837185909"
)
(PRINC "\n已完成，共有")
(PRINC (LENGTH C6))
(PRINC "桩编号被提取坐标!")
)
)
(PRINC)
)
(DEFUN ZFCL (A / A1 A2 A3 A4 B)
(setq A1 (STRLEN A))
(setq A2 (- A1 1))
(setq B "")
(while (and (>= A2 0))
(setq A3 (VL-STRING-ELT A A2))
(if (AND (>= A3 48) (<= A3 57))
(PROGN (setq B (STRCAT (CHR A3) B)))
(PROGN (setq A2 -1))
)
(setq A2 (1- A2))
)
(setq JH1 B)
(setq A4 (STRLEN JH1))
(setq JH2 (SUBSTR A 1 (- A1 A4)))
(setq JH1 B)
)
(DEFUN SCXTZB (C4 / JJ J J1 Q1 Q2)
(setq JJ (LENGTH C4))
(setq J 0)
(setq Q1 0)
(setq Q2 0)
(setq JJK nil)
(setq JJH nil)
(while (and (< J JJ))
(setq J1 (NTH J C4))
(if (= Q1 0)
(PROGN (setq JJK (APPEND JJK (LIST J1))))
(PROGN
(FOREACH X JJK
(if (AND (EQUAL (car (car (cdr J1))) (car (car (cdr X))) 0.1)
(EQUAL (car (cdr (car (cdr J1))))
(car (cdr (car (cdr X))))
0.1
)
)
(PROGN (setq Q2 1) (setq JJH (APPEND JJH (LIST J1))))
)
)
(if (= Q2 0)
(PROGN (setq JJK (APPEND JJK (LIST J1))))
)
(setq Q2 0)
)
)
(setq Q1 1)
(setq J (1+ J))
)
(PRINC)
)