设为首页收藏本站CAD论坛CAD教程CAD下载明经币充值
切换到宽版

明经CAD社区

 找回密码
 注册

QQ登录

只需一步，快速开始

搜索
明经CAD社区»社区 › 开发篇 › AutoLISP/Visual LISP 编程技术 › 求大神帮我改下这个源码 提出来的坐标显示不出来
12下一页
返回列表 发新帖
查看: 674|回复: 11

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

[复制链接]
787116960
发表于 2020-3-2 14:33 | 显示全部楼层 |阅读模式
  1. (DEFUN C:TEST ()
  2. (SETVAR "CMDECHO" 0)
  3. (SETQ OLDOS (GETVAR "OSMODE"))
  4. (SETVAR "OSMODE" 0)
  5. (SETQ LN "LL")
  6. (WHILE (NOT (WCMATCH LN "*POLYLINE"))
  7.   (SETQ SE (ENTSEL "\nSelect a Polyline :")
  8. ENT (ENTGET (CAR SE))
  9. LN (CDR (ASSOC 0 ENT)))
  10. )
  11. (SETQ PT (CADR SE))
  12. (IF (SETQ DD (GETDIST "\nEnter Distance for Measure :")) (PROGN
  13.   (IF (= LN "LWPOLYLINE")
  14.    (SETQ PT1 (CDR (ASSOC 10 ENT))
  15.   PT2 (CDR (ASSOC 10 (REVERSE ENT))))
  16.   (PROGN
  17.    (SETQ SN1 (ENTNEXT (CDR (ASSOC -1 ENT)))
  18.          LB (ENTGET SN1)          LM (CDR (ASSOC 0 LB))
  19.          PT1 (CDR (ASSOC 10 LB)))
  20.    (WHILE (/= LM "SEQEND")
  21.     (SETQ SN1 (ENTNEXT (CDR (ASSOC -1 LB)))  LB (ENTGET SN1)
  22.           LM (CDR (ASSOC 0 LB))        PT2 (CDR (ASSOC 10 LB)))
  23.    )
  24.   ))
  25.   (IF (> (DISTANCE PT PT1) (DISTANCE PT PT2)) (SETQ PTT PT1 PT1 PT2 PT2 PTT))
  26.   (COMMAND "MEASURE" PT DD)
  27.   (SETQ SS (SSGET "P")
  28. PT0 (CDR (ASSOC 10 (ENTGET (SSNAME SS 0))))
  29. SL (SSLENGTH SS) DL (LIST (APPEND PT1 (LIST 0.0))))
  30.   (IF (> (DISTANCE PT0 PT1) (DISTANCE PT0 PT2))
  31.    (SETQ I (1- SS) N -1)
  32.    (SETQ I 0 N 1)
  33.   )
  34.   (REPEAT (SSLENGTH SS)
  35.    (SETQ PTT (CDR (ASSOC 10 (ENTGET (SSNAME SS I))))
  36.          I (+ I N)
  37.   DL (APPEND DL (LIST PTT)))
  38.   )
  39.   (SETQ DL (APPEND DL (LIST (APPEND PT2 (LIST 0.0)))))
  40.   (SETQ NM (IF NM NM ""))
  41.   (IF (SETQ NM (GETFILED "Select file name to write :" NM "txt" 1)) (PROGN
  42.    (SETQ FP (OPEN NM "w")
  43.   I -1)
  44.    (REPEAT (LENGTH DL)
  45.     (PRINC (NTH (SETQ I (1+ I)) DL) FP) (PRINC "\n" FP)
  46.    )
  47.    (CLOSE FP)
  48.    (COMMAND "NOTEPAD" NM)
  49.   ))
  50. ))
  51. (SETVAR "OSMODE" OLDOS)
  52. (SETVAR "CMDECHO" 1)
  53. (PRINC)
  54. )
复制代码

本帖子中包含更多资源

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

x
回复

使用道具 举报

yshf
发表于 2020-3-5 13:07 | 显示全部楼层
本帖最后由 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 (car  pt) 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 | 显示全部楼层
(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 | 显示全部楼层
yshf 发表于 2020-3-5 13:07
(DEFUN C:TEST ()
    (SETVAR "CMDECHO" 0)
    (SETQ OLDOS (GETVAR "OSMODE"))

谢谢大神  可以用了   可以加入圆弧也可以提取吗  这个阔以提取多段线了
回复 支持 反对

使用道具 举报

llsheng_73
发表于 2020-3-2 17:42 | 显示全部楼层
输出到文件的时候，先把它转成字符串，设置好小数位
回复 支持 反对

使用道具 举报

787116960
 楼主| 发表于 2020-3-2 19:07 | 显示全部楼层
llsheng_73 发表于 2020-3-2 17:42
输出到文件的时候，先把它转成字符串，设置好小数位

能帮下忙吗  大佬  这个源码是论坛找的
回复 支持 反对

使用道具 举报

烟盒迷唇
发表于 2020-3-3 09:50 | 显示全部楼层
改了效果不错吧
回复 支持 反对

使用道具 举报

787116960
 楼主| 发表于 2020-3-4 12:23 | 显示全部楼层
bssurvey 发表于 2020-3-3 08:47
(DEFUN C:TEST ()
(SETVAR "CMDECHO" 0)
(SETQ OLDOS (GETVAR "OSMODE"))

谢谢  我这里显示参数不对呢
回复 支持 反对

使用道具 举报

787116960
 楼主| 发表于 2020-3-4 12:25 | 显示全部楼层
bssurvey 发表于 2020-3-3 08:47
(DEFUN C:TEST ()
(SETVAR "CMDECHO" 0)
(SETQ OLDOS (GETVAR "OSMODE"))

XY坐标显示不完全了
回复 支持 反对

使用道具 举报

787116960
 楼主| 发表于 2020-3-4 12:27 | 显示全部楼层
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 | 显示全部楼层
787116960 发表于 2020-3-4 12:27
命令: test
Select a Polyline :
Enter Distance for Measure :100

好像是版本的問題 我是用cad2008正常
回复 支持 反对

使用道具 举报

787116960
 楼主| 发表于 2020-3-5 12:29 | 显示全部楼层
bssurvey 发表于 2020-3-5 11:29
好像是版本的問題 我是用cad2008正常

我的也是cad2008   可能是圆弧不能提取
回复 支持 反对

使用道具 举报

12下一页
返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码，在未取得本站及作者授权的情况下，不得用于商业用途

GMT+8, 2024-6-14 01:57 , Processed in 0.163266 second(s), 28 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表