787116960 发表于 2020-3-2 14:33:07

求大神帮我改下这个源码 提出来的坐标显示不出来

(DEFUN C:TEST ()
(SETVAR "CMDECHO" 0)
(SETQ OLDOS (GETVAR "OSMODE"))
(SETVAR "OSMODE" 0)
(SETQ LN "LL")
(WHILE (NOT (WCMATCH LN "*POLYLINE"))
(SETQ SE (ENTSEL "\nSelect a Polyline :")
ENT (ENTGET (CAR SE))
LN (CDR (ASSOC 0 ENT)))
)
(SETQ PT (CADR SE))
(IF (SETQ DD (GETDIST "\nEnter Distance for Measure :")) (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 "Select file name to write :" NM "txt" 1)) (PROGN
   (SETQ FP (OPEN NM "w")
I -1)
   (REPEAT (LENGTH DL)
    (PRINC (NTH (SETQ I (1+ I)) DL) FP) (PRINC "\n" FP)
   )
   (CLOSE FP)
   (COMMAND "NOTEPAD" NM)
))
))
(SETVAR "OSMODE" OLDOS)
(SETVAR "CMDECHO" 1)
(PRINC)
)

yshf 发表于 2020-3-5 13:07:19

本帖最后由 yshf 于 2020-3-5 13:08 编辑

(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)
)

bssurvey 发表于 2020-3-3 08:47:15

(DEFUN C:TEST ()
(SETVAR "CMDECHO" 0)
(SETQ OLDOS (GETVAR "OSMODE"))
(SETVAR "OSMODE" 0)
(SETQ LN "LL")
(WHILE (NOT (WCMATCH LN "*POLYLINE"))
(SETQ SE (ENTSEL "\nSelect a Polyline :")
ENT (ENTGET (CAR SE))
LN (CDR (ASSOC 0 ENT)))
)
(SETQ PT (CADR SE))
(IF (SETQ DD (GETDIST "\nEnter Distance for Measure :")) (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 "Select file name to write :" NM "txt" 1)) (PROGN
   (SETQ FP (OPEN NM "w")
I -1)
   (REPEAT (LENGTH DL)
    (setq pt(NTH (SETQ I (1+ I)) DL))
    (PRINC (rtos (car pt) 2 3) FP)
    (PRINC " " FP)
    (PRINC (rtos (cadr pt) 2 3) FP)
    (PRINC " " FP)
    (PRINC (rtos (caddr pt) 2 3) FP)
    (PRINC "\n" FP)
   )
   (CLOSE FP)
   (COMMAND "NOTEPAD" NM)
))
))
(SETVAR "OSMODE" OLDOS)
(SETVAR "CMDECHO" 1)
(PRINC)
)

787116960 发表于 2020-3-6 12:19:28

yshf 发表于 2020-3-5 13:07
(DEFUN C:TEST ()
    (SETVAR "CMDECHO" 0)
    (SETQ OLDOS (GETVAR "OSMODE"))


谢谢大神可以用了   可以加入圆弧也可以提取吗这个阔以提取多段线了

llsheng_73 发表于 2020-3-2 17:42:27

输出到文件的时候，先把它转成字符串，设置好小数位

787116960 发表于 2020-3-2 19:07:39

llsheng_73 发表于 2020-3-2 17:42
输出到文件的时候，先把它转成字符串，设置好小数位

能帮下忙吗大佬这个源码是论坛找的

烟盒迷唇 发表于 2020-3-3 09:50:37

改了效果不错吧

787116960 发表于 2020-3-4 12:23:38

bssurvey 发表于 2020-3-3 08:47
(DEFUN C:TEST ()
(SETVAR "CMDECHO" 0)
(SETQ OLDOS (GETVAR "OSMODE"))


谢谢我这里显示参数不对呢

787116960 发表于 2020-3-4 12:25:27

bssurvey 发表于 2020-3-3 08:47
(DEFUN C:TEST ()
(SETVAR "CMDECHO" 0)
(SETQ OLDOS (GETVAR "OSMODE"))


XY坐标显示不完全了

787116960 发表于 2020-3-4 12:27:04

787116960 发表于 2020-3-4 12:23
谢谢我这里显示参数不对呢

命令: test
Select a Polyline :
Enter Distance for Measure :100
; 错误: 参数类型错误: numberp: <Selection set: 1ab>

bssurvey 发表于 2020-3-5 11:29:30

787116960 发表于 2020-3-4 12:27
命令: test
Select a Polyline :
Enter Distance for Measure :100


好像是版本的問題 我是用cad2008正常

787116960 发表于 2020-3-5 12:29:36

bssurvey 发表于 2020-3-5 11:29
好像是版本的問題 我是用cad2008正常

我的也是cad2008   可能是圆弧不能提取
页: [1] 2
查看完整版本: 求大神帮我改下这个源码 提出来的坐标显示不出来