(DEFUN C:TEST ()
(SETVAR "CMDECHO" 0)
(SETQ OLDOS (GETVAR "OSMODE"))
(SETVAR "OSMODE" 0)
(SETQ LN "LL")
(WHILE (NOT (WCMATCH LN "*POLYLINE"))
(SETQ SE (ENTSEL "\n请选取多段线:")
ENT (ENTGET (CAR SE))
LN (CDR (ASSOC 0 ENT)))
)
(SETQ PT (CADR SE))
(IF (SETQ DD (GETDIST "\n请输入测量距离:"))
(PROGN
(IF (= LN "LWPOLYLINE")
(SETQ PT1 (CDR (ASSOC 10 ENT))
PT2 (CDR (ASSOC 10 (REVERSE ENT)))
)
(PROGN
(SETQ SN1 (ENTNEXT (CDR (ASSOC -1 ENT)))
LB (ENTGET SN1)
LM (CDR (ASSOC 0 LB))
PT1 (CDR (ASSOC 10 LB))
)
(WHILE (/= LM "SEQEND")
(SETQ SN1 (ENTNEXT (CDR (ASSOC -1 LB)))
LB (ENTGET SN1)
LM (CDR (ASSOC 0 LB))
PT2 (CDR (ASSOC 10 LB))
)
)
)
)
(IF (> (DISTANCE PT PT1) (DISTANCE PT PT2))
(SETQ PTT PT1 PT1 PT2 PT2 PTT)
)
(COMMAND "MEASURE" PT DD)
(SETQ SS (SSGET "P")
PT0 (CDR (ASSOC 10 (ENTGET (SSNAME SS 0))))
SL (SSLENGTH SS) DL (LIST (APPEND PT1 (LIST 0.0)))
)
(IF (> (DISTANCE PT0 PT1) (DISTANCE PT0 PT2))
(SETQ I (1- SS) N -1)
(SETQ I 0 N 1)
)
(REPEAT (SSLENGTH SS)
(SETQ PTT (CDR (ASSOC 10 (ENTGET (SSNAME SS I))))
I (+ I N)
DL (APPEND DL (LIST PTT))
)
)
(SETQ DL (APPEND DL (LIST (APPEND PT2 (LIST 0.0)))))
(SETQ NM (IF NM NM ""))
(IF (SETQ NM (GETFILED "请选择存盘文件 :" NM "txt" 1))
(PROGN
(SETQ FP (OPEN NM "w")
I -1
)
(REPEAT (LENGTH DL)
(setq pt (NTH (SETQ I (1+ I)) DL))
(PRINC (strcat "(" (rtos (carpt) 2 3)
" " (rtos (cadr pt) 2 3)
" " (rtos (last pt) 2 3)
")\n"
)
FP
)
)
(CLOSE FP)
(COMMAND "NOTEPAD" NM)
)
)
)
)
(SETVAR "OSMODE" OLDOS)
(SETVAR "CMDECHO" 1)
(PRINC)
)
yshf 发表于 2020-3-5 13:07
(DEFUN C:TEST ()
(SETVAR "CMDECHO" 0)
(SETQ OLDOS (GETVAR "OSMODE"))
谢谢大神可以用了 可以加入圆弧也可以提取吗这个阔以提取多段线了
页:
1
[2]