设为首页收藏本站

晓东CAD家园-论坛

 找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 103|回复: 2

[原创] 校核lsp中的变量

[复制链接]

已领礼包: 182个

财富等级: 日进斗金

发表于 2020-6-11 14:49:29 | 显示全部楼层 |阅读模式

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

您需要 登录 才可以下载或查看,没有帐号?立即注册

x
在txt文档中写的lsp程序,在变量较多时,校核变量是一件费时费力,也挺头疼的事。
即使在将lsp程序加载到vlide里面自动提取,但与手写的比较起来也挺费事。
下面的程序可以帮助缓解一下校核变量的烦恼。
(defun c:tt(/ str1 str2 lst1 lst2 lst-a lst-b lst-c)
        (defun get::lst(str)
                (mapcar
                        '(lambda(x)
                                (strcase x t)
                        )
                        (xdrx_string_sort (xdrx_string_regexps "[a-z\\-\\0-9]+" str))
                );;;mapcar
        );;;defun
        (if (and (setq str1 (xdrx_ui_getstring "字符串输入" "输入vlide提取的字符串:"))(setq str2 (xdrx_ui_getstring "字符串输入" "输入lsp中的字符串:")))
                (progn
                        (setq lst1 (get::lst str1)
                                lst2 (get::lst str2)
                        );;;setq
                        (setq lst-a
                                (vl-remove-if
                                        '(lambda(x)
                                                (vl-position x lst2)
                                        )
                                        lst1
                                );;;vl
                                lst-b
                                (vl-remove-if
                                        '(lambda(x)
                                                (vl-position x lst1)
                                        )
                                        lst2
                                );;;vl
                                lst-c
                                (xd::list:dup lst2)
                        );;;setq
                        (if lst-a
                                (xdrx_prompt "\nvlide中多余的变量表为: (" (XD::List->String lst-a " ") ") \n")
                        );;;if
                        (if lst-b
                                (xdrx_prompt "\nlsp中多余的变量表为: (" (XD::List->String lst-b " ") ") \n")
                        );;;if
                        (if (and (not lst-a) (not lst-b))
                                (xdrx_prompt "\nvlide与lsp中的变量相同\n")
                        );;;if
                        (if lst-c
                                (xdrx_prompt "\nlsp中有重复的变量为: (" (XD::List->String lst-c " ") ") \n")
                        );;;if
                );;;progn
        );;;if
        (princ)
);;;defun





论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!

已领礼包: 40个

财富等级: 招财进宝

发表于 2020-6-11 15:08:42 | 显示全部楼层
怎么用这个?
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 182个

财富等级: 日进斗金

 楼主| 发表于 2020-6-11 16:26:36 | 显示全部楼层
比如:下面这段程序变量就挺多的
(mapcar
                                        '(lambda(x / lst-sp lst-d-gj-sp b-sp h-sp lst-jmq-sp lst-fjmq-sp lst-hxq-sp
                                                        lst-d-gj-fj lst1-gj-fj lst1-hxq-fj lst1-gj-sp lst1-hxq-sp
                                                        jmq-sp jmq-sp-min jmq-sp-max fjmq-sp fjmq-sp-min fjmq-sp-max hxq-sp hxq-sp-min hxq-sp-max
                                                        lst-js b-js h-js jmq-js fjmq-js hxq-js e-bk)
                                                (if (setq lst-sp (assoc (car x) lst-tab))
                                                        (progn
                                                                (setq lst-d-gj-sp (last lst-sp);;;箍筋及核心区详图实配值(强度值、直径、间距)
                                                                        lst-sp (cdr lst-sp);;;去掉开始一位
                                                                        lst-sp (reverse (cdr (reverse lst-sp)));;;去掉结尾一位
                                                                        b-sp (car lst-sp)
                                                                        h-sp (cadr lst-sp)
                                                                        lst-jmq-sp (caddr lst-sp)
                                                                        lst-fjmq-sp (nth 3 lst-sp)
                                                                        lst-hxq-sp (last lst-sp)
                                                                );;;setq
                                                                ;;;根据平面图中的附加箍筋、附加核心区箍筋修改箍筋、核心区表(涉及强度等级问题,加上)
                                                                (if (setq lst-d-gj-fj (last x))
                                                                        (progn
                                                                                ;;;下面四个均带有强度等级值
                                                                                (setq lst1-gj-fj (cdr (assoc "GJ-FJ" lst-d-gj-fj))
                                                                                        lst1-hxq-fj (cdr (assoc "HXQ-FJ" lst-d-gj-fj))
                                                                                        lst1-gj-sp (cdr (assoc "GJ-SP" lst-d-gj-sp))
                                                                                        lst1-hxq-sp (cdr (assoc "HXQ-SP" lst-d-gj-sp))
                                                                                );;;setq
                                                                                (cond
                                                                                        ((and (not lst1-gj-fj) lst1-hxq-fj);;;无附加箍筋、有附加核心区箍筋
                                                                                                (cond
                                                                                                        ((not lst1-hxq-sp);;;无实配的核心区箍筋,有实配箍筋
                                                                                                                (setq lst-hxq-sp (gj_hxq_th lst1-hxq-fj lst1-gj-sp lst-hxq-sp "hxq"))                                       
                                                                                                        );;;cond1
                                                                                                        ;;;有实配的核心区箍筋,有实配箍筋
                                                                                                        (t
                                                                                                                (setq lst-hxq-sp (gj_hxq_th lst1-hxq-fj lst1-hxq-sp lst-hxq-sp "hxq"))
                                                                                                        );;;cond2
                                                                                                );;;cond
                                                                                        );;;cond1
                                                                                        ((and lst1-gj-fj (not lst1-hxq-fj));;;有附加箍筋、无附加核心区箍筋
                                                                                                (cond
                                                                                                        ((not lst1-hxq-sp);;;无实配的核心区箍筋,有实配箍筋
                                                                                                                (setq lst-jmq-sp (gj_hxq_th lst1-gj-fj lst1-gj-sp lst-jmq-sp "jmq")
                                                                                                                        lst-fjmq-sp (gj_hxq_th lst1-gj-fj lst1-gj-sp lst-fjmq-sp "fjmq")
                                                                                                                        lst-hxq-sp lst-jmq-sp
                                                                                                                );;;setq                                       
                                                                                                        );;;cond1
                                                                                                        ;;;有实配的核心区箍筋,有实配箍筋
                                                                                                        (t
                                                                                                                (setq lst-jmq-sp (gj_hxq_th lst1-gj-fj lst1-gj-sp lst-jmq-sp "jmq")
                                                                                                                        lst-fjmq-sp (gj_hxq_th lst1-gj-fj lst1-gj-sp lst-fjmq-sp "fjmq")
                                                                                                                );;;setq
                                                                                                        );;;cond2
                                                                                                );;;cond
                                                                                        );;;cond2
                                                                                        ((and lst1-gj-fj lst1-hxq-fj);;;有附加箍筋、有附加核心区箍筋
                                                                                                (cond
                                                                                                        ((not lst1-hxq-sp);;;无实配的核心区箍筋,有实配箍筋
                                                                                                                (setq lst-jmq-sp (gj_hxq_th lst1-gj-fj lst1-gj-sp lst-jmq-sp "jmq")
                                                                                                                        lst-fjmq-sp (gj_hxq_th lst1-gj-fj lst1-gj-sp lst-fjmq-sp "fjmq")
                                                                                                                        lst-hxq-sp (gj_hxq_th lst1-hxq-fj lst1-gj-sp lst-hxq-sp "hxq")
                                                                                                                );;;setq                                       
                                                                                                        );;;cond1
                                                                                                        ;;;有实配的核心区箍筋,有实配箍筋
                                                                                                        (t
                                                                                                                (setq lst-jmq-sp (gj_hxq_th lst1-gj-fj lst1-gj-sp lst-jmq-sp "jmq")
                                                                                                                        lst-fjmq-sp (gj_hxq_th lst1-gj-fj lst1-gj-sp lst-fjmq-sp "fjmq")
                                                                                                                        lst-hxq-sp (gj_hxq_th lst1-hxq-fj lst1-hxq-sp lst-hxq-sp "hxq")
                                                                                                                );;;setq
                                                                                                        );;;cond2
                                                                                                );;;cond       
                                                                                        );;;cond3
                                                                                );;;cond
                                                                        );;;progn       
                                                                );;;if
                                                                (if (apply '= lst-jmq-sp)
                                                                        (setq jmq-sp (car lst-jmq-sp))
                                                                        (setq jmq-sp-min (car lst-jmq-sp)
                                                                                jmq-sp-max (cadr lst-jmq-sp)
                                                                        );;;setq
                                                                );;;if
                                                                (if (apply '= lst-fjmq-sp)
                                                                        (setq fjmq-sp (car lst-fjmq-sp))
                                                                        (setq fjmq-sp-min (car lst-fjmq-sp)
                                                                                fjmq-sp-max (cadr lst-fjmq-sp)
                                                                        );;;setq
                                                                );;;if
                                                                (if (apply '= lst-hxq-sp)
                                                                        (setq hxq-sp (car lst-hxq-sp))
                                                                        (setq hxq-sp-min (car lst-hxq-sp)
                                                                                hxq-sp-max (cadr lst-hxq-sp)
                                                                        );;;setq
                                                                );;;if
                                                                (setq lst-js (cadr x)
                                                                        e-bk (car lst-js)
                                                                        lst-js (cdr lst-js)
                                                                        b-js (car lst-js)
                                                                        h-js (cadr lst-js)
                                                                        jmq-js (caddr lst-js)
                                                                        fjmq-js (nth 3 lst-js)
                                                                        hxq-js (last lst-js)
                                                                );;;setq
                                                                (if (< b-sp (- b-js 153.))
                                                                        (setq lst-b (cons e-bk lst-b))
                                                                );;;if
                                                                (if (< h-sp (- h-js 153.))
                                                                        (setq lst-h (cons e-bk lst-h))
                                                                );;;if
                                                                (if jmq-sp
                                                                        (if (< jmq-sp (- jmq-js 50.24))
                                                                                (setq lst-jmq (cons e-bk lst-jmq))
                                                                        );;;if
                                                                        (if (< jmq-sp-max (- jmq-js 50.24))
                                                                                (setq lst-jmq (cons e-bk lst-jmq))
                                                                                (if (< jmq-sp-min (- jmq-js 50.24))
                                                                                        (setq lst-jmq-min (cons e-bk lst-jmq-min))
                                                                                );;;if
                                                                        );;;if
                                                                );;;if
                                                                (if fjmq-sp
                                                                        (if (< fjmq-sp (- fjmq-js 50.24))
                                                                                (setq lst-fjmq (cons e-bk lst-fjmq))
                                                                        );;;if
                                                                        (if (< fjmq-sp-max (- fjmq-js 50.24))
                                                                                (setq lst-fjmq (cons e-bk lst-fjmq))
                                                                                (if (< fjmq-sp-min (- fjmq-js 50.24))
                                                                                        (setq lst-fjmq-min (cons e-bk lst-fjmq-min))
                                                                                );;;if
                                                                        );;;if
                                                                );;;if
                                                                (if hxq-sp
                                                                        (if (< hxq-sp (- hxq-js 50.24))
                                                                                (setq lst-hxq (cons e-bk lst-hxq))
                                                                        );;;if
                                                                        (if (< hxq-sp-max (- hxq-js 50.24))
                                                                                (setq lst-hxq (cons e-bk lst-hxq))
                                                                                (if (< hxq-sp-min (- hxq-js 50.24))
                                                                                        (setq lst-hxq-min (cons e-bk lst-hxq-min))
                                                                                );;;if
                                                                        );;;if
                                                                );;;if
                                                        );;;progn
                                                        (setq lst-no-xt (cons (car x) lst-no-xt));;;无详图的编号表
                                                );;;if
                                        );;;lambda
                                        lst-pm
                                );;;mapcar

这个里面的变量是否同程序中一致呢,挺难校核的
'(lambda(x / lst-sp lst-d-gj-sp b-sp h-sp lst-jmq-sp lst-fjmq-sp lst-hxq-sp
                                                        lst-d-gj-fj lst1-gj-fj lst1-hxq-fj lst1-gj-sp lst1-hxq-sp
                                                        jmq-sp jmq-sp-min jmq-sp-max fjmq-sp fjmq-sp-min fjmq-sp-max hxq-sp hxq-sp-min hxq-sp-max
                                                        lst-js b-js h-js jmq-js fjmq-js hxq-js e-bk)

首先打开_vlide,新建文件,复制黏贴代码
编辑->全部选定->检查选定代码
复制黏贴; 全局变量: (B-JS B-SP E-BK FJMQ-JS FJMQ-SP FJMQ-SP-MAX FJMQ-SP-MIN H-JS H-SP HXQ-JS HXQ-SP HXQ-SP-MAX HXQ-SP-MIN JMQ-JS JMQ-SP JMQ-SP-MAX JMQ-SP-MIN LST-B LST-D-GJ-FJ LST-D-GJ-SP LST-FJMQ LST-FJMQ-MIN LST-FJMQ-SP LST-H LST-HXQ LST-HXQ-MIN LST-HXQ-SP LST-JMQ LST-JMQ-MIN LST-JMQ-SP LST-JS LST-NO-XT LST-PM LST-SP LST-TAB LST1-GJ-FJ LST1-GJ-SP LST1-HXQ-FJ LST1-HXQ-SP X)
; 检查完成.  作为第一个str1的文字,
str2就是lsp程序中'(lambda(x/ ) 里面的变量
这样就能够自动比较了。

论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|小黑屋|手机版|Archiver|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )  

GMT+8, 2020-10-21 13:20 , Processed in 0.131130 second(s), 31 queries , Gzip On, WinCache On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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