本人菜鸟，最近刚做了个lisp程序，在编译时，出现错误，请给我指出错误

dyjwyqz5221 · 发表于 2018-5-9 14:56:58

本帖最后由 newer 于 2018-5-9 15:34 编辑

编译时，出现如下错误：
_$
参数类型错误: losid_subtype_p nil
_$
_$
_$
参数值错误: 非负: -1
_$

下面是源程序代码
;;;;&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
(defun c:tt (/ a aaa b bidui-1 bd1 bd2 c d e_xt jisuan lst1 lst2 ss-p ss-x0 ss ss1 t1 t2 w-gouzao
w-jisuan w-jisuan-1 x y
)
(vl-load-com)
(setvar "CMDECHO" 0)
(setvar "osmode" 0)
(xdrx_begin)
(if (and (setq ss-p (xd::ssget "\n选取平面图（框选）<右键退出>:"
'(":L"
((-4 . "<OR")
(-4 . "<AND")
(0 . "TEXT")
(1 . "*BZ*")
(-4 . "AND>")
(-4 . "<AND")
(0 . "*POLYLINE")
(8 . "S_EDGEMEMBERSHAPEDASH")
(-4 . "&=")
(70 . 1)
(-4 . "AND>")
(-4 . "OR>")
)
)
)
)
;;setq ss-p
(setq ss-x0 (xd::ssget "\n选取边缘构件详图（框选）<右键退出>:"
'(":L"
((0 . "LWPOLYLINE")
(-4 . "<AND")
(8 . "0-详图闭合线框")
(62 . 6)
(-4 . "&=")
(70 . 1)
(-4 . "AND>")
)
)
)
)
;;setq ss-x0 为详图中(0 . "LWPOLYLINE")(8 . "0-详图闭合线框")(62 . 6)的复线框选择集
)
;;and
(progn (setq t1 (getvar "date")) ;记录开始时间t1
(setq ss (XD::Pickset:GetSub ss-p '((0 . "TEXT") (1 . "*BZ*")))
;;;提取带“BZ”的文字，形成平面图的边缘构件编号选择集ss
ss1 (XD::Pickset:GetSub
ss-p
'((0 . "*POLYLINE")
(8 . "S_EDGEMEMBERSHAPEDASH")
(-4 . "&=")
(70 . 1)
)
)
;;;提取平面图中的闭合粗线框，形成平面图的粗线框选择集ss1
)
;;;setq
(setq jisuan (yqz::pickset:shiti ss1 ss))
;;;取得平面图中，（边缘构件复线框图元名、*BZ名称、计算配筋）一一对应表jisuan
(setq e-xt (yqz::pickset:xt ss-x0))
;;;直接生成详图表，（边缘构件图元名边缘构件名称实配钢筋面积构造配筋面积）
(setq lst1 (mapcar '(lambda (x) (yqz::format (XD::Obj:DXF x 1)))
;;
(xdrx_pickset->ents ss)
)
;;;mapcar，形成平面图BZ名称表
lst2 (mapcar '(lambda (x) (cadr x))
;;
e-xt
)
;;;mapcar ;;;形成详图Z名称表（包括KZ，Z，LZ等，否则可能与配筋不一一对应）
)
;;;setq
(if (setq aaa (yqz::list:dup lst2))
(progn (setq aaa (yqz::paixu aaa))
(setq d (strcat "详图中存在重复详图的边缘构件："
(XD::LIST->STRING aaa "、")
"，其计算配筋未与实配钢筋进行比对。"
)
)
)
;;;progn
(setq aaa '())
)
;;;if
(setq bd1 (yqz::list:dup-1 lst1 lst2))
(setq bd2 (yqz::list:dup-1 lst2 lst1))
;;;将边缘构件顺序从小到大的顺序进行排序
(if (/= bd1 nil)
(setq bd1 (yqz::paixu bd1))
)
(if (/= bd2 nil)
(setq bd2 (yqz::paixu bd2))
)
(if (or (/= bd1 nil) (/= bd2 nil))
(progn (if (and (/= bd1 nil) (/= bd2 nil))
(setq bidui-1 (strcat "平面图边缘构件"
(XD::LIST->STRING bd1 "、")
"无详图;详图边缘构件"
(XD::LIST->STRING bd2 "、")
"在平面图中未找到。"
)
)
)
;;;if
(if (and (/= bd1 nil) (= bd2 nil))
(setq bidui-1 (strcat "平面图边缘构件"
(XD::LIST->STRING bd1 "、")
"无详图。"
)
)
)
;;;if
(if (and (= bd1 nil) (/= bd2 nil))
(setq bidui-1 (strcat "详图边缘构件"
(XD::LIST->STRING bd2 "、")
"在平面图中未找到。"
)
)
)
;;;if
)
;;;progn
(setq bidui-1 '())
)
;;;if
;;;以下为对构造配筋的比对，测试正确
(setq w-gouzao (mapcar 'cadr
(vl-remove-if-not
'(lambda (x) (< (caddr x) (last x)))
;;;lambda(x)
e-xt
)
;;vl-remove-if-not
)
;;;mapcar
)
;;;setq w-gouzao
;;;以下为对实配钢筋与计算配筋的比对
(setq
w-jisuan (vl-remove
nil
(mapcar '(lambda (x)
(vl-remove-if-not
'(lambda (y)
(if (and (not (member (cadr x) aaa)) (= (cadr x) (cadr y)))
(< (caddr x) (caddr y))
nil
)
;;;if
)
;;;lambda(y)
jisuan
)
;;;vl-remove-if
)
;;;lambda(x)
e-xt
)
;;;mapcar
)
;;;vl-remove nil
)
;;;setq w-jisuan
(setq w-jisuan (list-n w-jisuan)
w-jisuan (XD::List:GroupByNum w-jisuan 3)
w-jisuan-1 (mapcar '(lambda (x) (cadr x)) w-jisuan)
;;;mapcar
)
;;;setq
;;;文字预处理
(if (/= bidui-1 nil)
(setq a bidui-1)
)
(if (/= w-gouzao nil)
(progn (setq w-gouzao (yqz::paixu w-gouzao))
(setq b (strcat "详图中，边缘构件"
(XD::LIST->STRING w-gouzao "、")
"的实配钢筋面积小于构造配筋面积。"
)
)
)
;;;progn
)
;;;if
(if (/= w-jisuan-1 nil)
(progn (setq w-jisuan-1 (yqz::paixu w-jisuan-1))
(setq c (strcat "平面图中，边缘构件"
(XD::LIST->STRING w-jisuan-1 "、")
"的实配钢筋面积小于计算配筋面积。（位置见平面图圆圈部分）"
)
)
)
;;;progn
)
;;;if
;;;最新、最快捷的文字标注方式，a b c d...为文字串，或nil
(if (not (equal (list a b c d) nil))
(progn (setq point1 (getpoint "选取文字插入点："))
(setq n 0)
(mapcar '(lambda (x)
(setq n (1+ n))
(xdrx_text_make
(list (car point1) (- (cadr point1) (* (1- n) 700)))
(strcat (xdrx_prompt n t) "、" x)
"STANDARD"
400
(xdrx_vector_angle (getvar "wcsxdir"))
)
)
;;;lambda(x)
(vl-remove nil (list a b c d))
)
;;;mapcar
(if (listp w-jisuan)
(mapcar '(lambda (x)
(entmakex (list '(0 . "CIRCLE")
(cons 10 (XD::Geom:Get9PT (car x) 4))
'(40 . 800.0)
'(62 . 1)
)
)
)
;;;lambda(x)
w-jisuan
)
;;;mapcar
)
;;;if
;;;(if (listp w-jisuan)
;;;(mapcar
;;;'(lambda(x)
;;;(entmakex (list '(0 . "CIRCLE")(cons 10 (XD::Geom:Get9PT (car x) 4)) '(40 . 800.0) '(62 . 1)))
;;;);;;lambda(x)
;;;w-jisuan
;;;);;;mapcar
;;;);;;if
)
;;;progn
(princ "\n比对结果均ok!")
)
;;if
)
;;;progn
)
;;;if
(setq t2 (getvar "date")) ;记录结束时间t2
(princ (menucmd (strcat "M=$(edtime,"
(rtos (- t2 t1) 2 16)
",HH:MM:SS:MSEC)"
)
)
)
;;;显示时间
(xdrx_end)
(setvar "CMDECHO" 1)
(setvar "osmode" 1)
(princ)
)
;;;defun
;;;***********************************************************************
;;;以下为自定义函数
(defun XD::Geom:Get9PT (e index / box)
(setq box (XD::Geom:9pt e))
(nth index box)
)
(defun yqz::paixu (lst / x1 x2)
;;;排序函数，用于结果中，BZ的排序
(vl-sort lst
'(lambda (x1 x2)
(< (atoi (xd::string:regexpr "[^0-9]" x1 "" ""))
(atoi (xd::string:regexpr "[^0-9]" x2 "" ""))
)
)
;;;lambda
)
;;;vl-sort lst
)
;;;defun
;;;函数功能：用正则法则进行查找替换，去掉字符串中的*及（）、()中的内容，括号内带有字母及数字时，有问题。
(defun yqz::format (a)
(xd::string:regexpr "[^Y|GBZ\\-0-9]" a "" "")
)
;;;defun
(defun yqz::format1 (a) (xd::string:regexpr " " a "" ""))
;;;defun
(defun yqz::list:dup (lst / e lst1)
(while (setq e (car lst))
(if (and (member e (setq lst (cdr lst))) (not (member e lst1)))
(setq lst1 (cons e lst1))
)
;;;if
)
;;;if
(reverse lst1)
)
;;;defun
(defun yqz::list:dup-1 (lst1 lst2 / e lst3)
;;;比对lst1是否均在lst2中
(while (setq e (car lst1))
(if (and (not (member e lst2)) (not (member e lst3)))
(setq lst3 (cons e lst3))
)
;;;if
(setq lst1 (cdr lst1))
)
;;;while
(reverse lst3)
)
;;;defun
;;;以下函数适用于详图
;;;_________________________________________________________________________________________________________________
(defun yqz::pickset:xt (ss / x a b c)
(mapcar '(lambda (x)
(setq a (yqz::format1
(XD::Pickset:PolyFence2 x '((0 . "TEXT") (1 . "*BZ*")))
)
)
(setq b (atoi (XD::Pickset:PolyFence2
x
'((0 . "TEXT") (8 . "0-实配钢筋面积"))
)
)
)
(setq c (atoi (XD::Pickset:PolyFence2
x
'((0 . "TEXT") (8 . "0-构造钢筋面积"))
)
)
)
(list x a b c)
)
;;;lambda(x)
(xdrx_pickset->ents ss)
)
;;;mapcar
)
;;;defun
(defun XD::Pickset:PolyFence2 (e fillter / pts pt1 pt3 ss1 name)
;;;e为边缘构件实体的图元名；fillter为条件，同ssget
(if (setq pts (xdrx_entity_box e))
;;;取得e实体的四点包围盒。
(progn (setq pt1 (offset-2 (car pts))
;;;将做左下角点往左偏移2700，往下偏移5400
pt3 (caddr pts)
;;;取右上角点
)
;;;setq
(setq ss1 (ssget "w" pt1 pt3 fillter))
;;;选取满足条件的选择集，w选择
(setq name (XD::Obj:DXF (car (xdrx_pickset->ents ss1)) 1)) ;选择集转实体表，并取出名称。
)
;;;progn
)
;;;if
name
)
;;;defun
(defun offset-2 (pt)
;;;将点的x坐标左移2700，y坐标下移5400mm，适应于pkpm
(setq pt (subst (- (car pt) 2700) (car pt) pt)
pt (subst (- (cadr pt) 5400) (cadr pt) pt)
)
;;;setq
)
;;;defun
;;;********************************************************************************************************************************
;;;以下函数的结果可能是表，也可能是nil。此函数仅对平面图中的构件其作用
;;;参数：ss-绿色边缘构件复线框选择集，ss-a 平面图中，边缘构件名称选择集
;;;返回结果：（边缘构件复线框图元名边缘构件名称计算配筋值）
;;;测试用时：0.299s
(defun yqz::pickset:shiti (ss ss-a / x lst t1 t2)
;;;形成只有“计算配筋”项的表，格式：（边框图元名引线图元名计算配筋）
;;;不是计算配筋控制的，均去掉了，简化与详图实配钢筋的比对进程。
(vl-remove nil
(mapcar '(lambda (x)
(setq lst (XD::Pickset:PolyFence1 x))
(if (/= (caddr lst) nil)
(list (car lst)
(yqz::format (yqz::format:aaa (cadr lst) ss-a))
(yqz::jisuanpeijin (caddr lst) (last lst))
)
nil
)
;;if
)
;;;lambda
(xdrx_pickset->ents ss)
)
;;;mapcar
)
;;;vl-remove nil
)
;;;defun
(defun XD::Pickset:PolyFence1 (e / pts pt1 pt3 pts-1 ss1 ss2 ss3 ss-a)
;;;e为边缘构件实体的图元名；ss_BZ为边缘构件编号选择集
(xdrx_ucson)
(if (setq pts (xdrx_entity_box e))
;;;取得e实体的四点包围盒。
(progn (setq pt1 (cadr pts)
pt3 (offset-1 (last pts))
;;;此点y坐标上提200mm
)
;;;setq
(setq pts-1 (xdrx_getsamplept e))
(setq ss1 (ssget "c"
pt1
pt3
'((0 . "text") (62 . 2) (1 . "计算配筋*"))
)
)
;;;计算配筋选择集
(setq ss2 (ssget "c"
pt1
pt3
'((0 . "text") (62 . 7) (1 . "构造配筋*"))
)
)
;;;构造配筋选择集
(setq ss3 (ssget "f"
pts-1
'((0 . "LINE") (67 . 0) (8 . "S_EDGEMEMBERTXT"))
)
)
;;;f选择与边缘框相交的直线到选择集中
(setq ss-a (list e (car (xdrx_pickset->ents ss3)) ss1 ss2))
;;;形成表 (边缘构件边框图元名斜直线图元名计算配筋选择集名构造配筋选择集名)
)
;;;progn
)
;;;if
(xdrx_ucsoff)
ss-a
)
;;;defun
(defun offset-1 (pt)
;;;将点的y坐标上提200mm，适应于pkpm
(setq pt (subst (+ (cadr pt) 200) (cadr pt) pt))
)
;;;defun
;;;找到引线对应的边缘构件名称，并进行处理，如：括号、*等。
(defun yqz::format:aaa (e ss-a)
(XD::Obj:DXF
(XD::Entity:NearByPnt1
ss-a
(xdrx_getpropertyvalue e "endpoint")
)
1
)
)
;;;defun
(defun XD::Obj:DXF (e a)
(if (listp e)
(cdr (assoc a (entget (car e))))
(cdr (assoc a (entget e)))
)
)
;;;defun
(defun yqz::jisuanpeijin (ss1 ss2 / a aa bb cc x y)
(if (not (equal ss1 nil))
;;;如果计算配筋选择集/=nil
(progn (setq aa (mapcar '(lambda (x)
(XD::String:ToNum
(XD::String:MatchBetween (XD::Obj:DXF x 1) "计算配筋" "mm")
)
)
;;;lambda(x)
(xdrx_pickset->ents ss1)
)
;;;mapcar，取出计算配筋控制的值，表的格式
)
;;;setq
(if (not (equal ss2 nil))
;;;如果白色构造配筋/=nil
(setq bb (mapcar '(lambda (y)
(XD::String:ToNum
(XD::String:MatchBetween (XD::Obj:DXF y 1) "构造配筋" "mm")
)
)
;;;lambda(y)
(xdrx_pickset->ents ss2)
)
;;;mapcar，取出构造配筋值表
)
;;;setq
(setq bb 0)
)
;;;if
(setq cc (list-n (list aa bb)))
;;;将aa、bb表合并为一个表，并且将表元素放置到第一层
(setq a (apply '+ cc))
;;;各元素的和
)
;;;progn
(setq a nil)
)
;;;if
a
)
;;dedun
;;;将表元素放置到第一层
(defun list-n (lst / func st)
(defun func (lst)
(if (null x)
(setq st '())
)
(foreach x lst
(if (listp x)
(func x)
(setq st (cons x st))
)
)
(reverse st)
)
(func lst)
)
;;;函数：XD::Entity:NearByPnt1;;;;暂时先这样，以后版本修改为所有点与选择集一一对应最近点
(defun XD::Entity:NearByPnt1 (el2 pt / box dis el1 pt2 pnt pnt1 x1 x2 y)
(if (= (type el2) 'PICKSET)
(setq el2 (xdrx_pickset->ents el2)) ;选择集转实体表，(<图元名: 7ff676e05a60> <图元名: 7ff676e05a50> <图元名: 7ff676e05a30>)
)
;;if
(setq el1 (mapcar '(lambda (y)
(setq box (xdrx_entity_box y))
;;;求出四点包围盒的坐标表((6.49192e+006 -3.54352e+006 0.0) (6.49303e+006 -3.54352e+006 0.0) (6.49303e+006 -3.54314e+006 0.0) (6.49192e+006 -3.54314e+006 0.0))
;;;此处现在的顺序是正确的，左下角点，右下角点，右上角点，左上角点！！！
(setq pnt (car box)
;;;
pnt1 (cadr box)
pt2 (xdrx_line_nearpoint pnt pnt1 pt)
dis (distance pt pt2)
)
;;;setq
(list dis y)
)
;;;lambda
el2
)
;;;mapcar
)
;;;setq
(cadar (vl-sort el1
'(lambda (x1 x2) (< (car x1) (car x2)))
;;;lambda
)
;;;vl-sort el1
)
;;;cadar
)
;;;defun
;;;************************************************************************************************************************

下面是源程序代码 
;;;;&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& 
(defun c:tt (/ a aaa b bidui-1 bd1 bd2 c d e_xt jisuan lst1 lst2 ss-p ss-x0 ss ss1 t1 t2 w-gouzao 
             w-jisuan w-jisuan-1 x y 
            ) 
  (vl-load-com) 
  (setvar "CMDECHO" 0) 
  (setvar "osmode" 0) 
  (xdrx_begin) 
  (if (and (setq ss-p (xd::ssget "\n选取平面图（框选）<右键退出>:" 
                                 '(":L" 
                                   ((-4 . "<OR") 
                                    (-4 . "<AND") 
                                    (0 . "TEXT") 
                                    (1 . "*BZ*") 
                                    (-4 . "AND>") 
                                    (-4 . "<AND") 
                                    (0 . "*POLYLINE") 
                                    (8 . "S_EDGEMEMBERSHAPEDASH") 
                                    (-4 . "&=") 
                                    (70 . 1) 
                                    (-4 . "AND>") 
                                    (-4 . "OR>") 
                                   ) 
                                  ) 
                      ) 
           ) 
           ;;setq ss-p 
           (setq ss-x0 (xd::ssget "\n选取边缘构件详图（框选）<右键退出>:" 
                                  '(":L" 
                                    ((0 . "LWPOLYLINE") 
                                     (-4 . "<AND") 
                                     (8 . "0-详图闭合线框") 
                                     (62 . 6) 
                                     (-4 . "&=") 
                                     (70 . 1) 
                                     (-4 . "AND>") 
                                    ) 
                                   ) 
                       ) 
           ) 
           ;;setq ss-x0 为详图中(0 . "LWPOLYLINE")(8 . "0-详图闭合线框")(62 . 6)的复线框选择集 
      ) 
    ;;and 
    (progn (setq t1 (getvar "date"))    ;记录开始时间t1 
           (setq ss  (XD::Pickset:GetSub ss-p '((0 . "TEXT") (1 . "*BZ*"))) 
;;;提取带“BZ”的文字，形成平面图的边缘构件编号选择集ss 
                 ss1 (XD::Pickset:GetSub 
                       ss-p 
                       '((0 . "*POLYLINE") 
                         (8 . "S_EDGEMEMBERSHAPEDASH") 
                         (-4 . "&=") 
                         (70 . 1) 
                        ) 
                     ) 
;;;提取平面图中的闭合粗线框，形成平面图的粗线框选择集ss1 
           ) 
;;;setq 
           (setq jisuan (yqz::pickset:shiti ss1 ss)) 
;;;取得平面图中，（边缘构件复线框图元名、*BZ名称、计算配筋）一一对应表jisuan 
           (setq e-xt (yqz::pickset:xt ss-x0)) 
;;;直接生成详图表，（边缘构件图元名 边缘构件名称 实配钢筋面积 构造配筋面积） 
           (setq lst1 (mapcar '(lambda (x) (yqz::format (XD::Obj:DXF x 1))) 
                              ;; 
                              (xdrx_pickset->ents ss) 
                      ) 
;;;mapcar，形成平面图BZ名称表 
                 lst2 (mapcar '(lambda (x) (cadr x)) 
                              ;; 
                              e-xt 
                      ) 
;;;mapcar ;;;形成详图Z名称表（包括KZ，Z，LZ等，否则可能与配筋不一一对应） 
           ) 
;;;setq 
           (if (setq aaa (yqz::list:dup lst2)) 
             (progn (setq aaa (yqz::paixu aaa)) 
                    (setq d (strcat "详图中存在重复详图的边缘构件：" 
                                    (XD::LIST->STRING aaa "、") 
                                    "，其计算配筋未与实配钢筋进行比对。" 
                            ) 
                    ) 
             ) 
;;;progn 
             (setq aaa '()) 
           ) 
;;;if                
           (setq bd1 (yqz::list:dup-1 lst1 lst2)) 
           (setq bd2 (yqz::list:dup-1 lst2 lst1)) 
;;;将边缘构件顺序从小到大的顺序进行排序 
           (if (/= bd1 nil) 
             (setq bd1 (yqz::paixu bd1)) 
           ) 
           (if (/= bd2 nil) 
             (setq bd2 (yqz::paixu bd2)) 
           ) 
           (if (or (/= bd1 nil) (/= bd2 nil)) 
             (progn (if (and (/= bd1 nil) (/= bd2 nil)) 
                      (setq bidui-1 (strcat "平面图边缘构件" 
                                            (XD::LIST->STRING bd1 "、") 
                                            "无详图;详图边缘构件" 
                                            (XD::LIST->STRING bd2 "、") 
                                            "在平面图中未找到。" 
                                    ) 
                      ) 
                    ) 
;;;if 
                    (if (and (/= bd1 nil) (= bd2 nil)) 
                      (setq bidui-1 (strcat "平面图边缘构件" 
                                            (XD::LIST->STRING bd1 "、") 
                                            "无详图。" 
                                    ) 
                      ) 
                    ) 
;;;if 
                    (if (and (= bd1 nil) (/= bd2 nil)) 
                      (setq bidui-1 (strcat "详图边缘构件" 
                                            (XD::LIST->STRING bd2 "、") 
                                            "在平面图中未找到。" 
                                    ) 
                      ) 
                    ) 
;;;if 
             ) 
;;;progn 
             (setq bidui-1 '()) 
           ) 
;;;if 
;;;以下为对构造配筋的比对，测试正确 
           (setq w-gouzao (mapcar 'cadr 
                                  (vl-remove-if-not 
                                    '(lambda (x) (< (caddr x) (last x))) 
;;;lambda(x) 
                                    e-xt 
                                  ) 
                                  ;;vl-remove-if-not                
                          ) 
;;;mapcar 
           ) 
;;;setq w-gouzao 
;;;以下为对实配钢筋与计算配筋的比对 
           (setq 
             w-jisuan (vl-remove 
                        nil 
                        (mapcar '(lambda (x) 
                                   (vl-remove-if-not 
                                     '(lambda (y) 
                                        (if (and (not (member (cadr x) aaa)) (= (cadr x) (cadr y))) 
                                          (< (caddr x) (caddr y)) 
                                          nil 
                                        ) 
;;;if 
                                      ) 
;;;lambda(y) 
                                     jisuan 
                                   ) 
;;;vl-remove-if         
                                 ) 
;;;lambda(x) 
                                e-xt 
                        ) 
;;;mapcar 
                      ) 
;;;vl-remove nil 
           ) 
;;;setq w-jisuan 
           (setq w-jisuan   (list-n w-jisuan) 
                 w-jisuan   (XD::List:GroupByNum w-jisuan 3) 
                 w-jisuan-1 (mapcar '(lambda (x) (cadr x)) w-jisuan) 
;;;mapcar 
           ) 
;;;setq 
;;;文字预处理 
           (if (/= bidui-1 nil) 
             (setq a bidui-1) 
           ) 
           (if (/= w-gouzao nil) 
             (progn (setq w-gouzao (yqz::paixu w-gouzao)) 
                    (setq b (strcat "详图中，边缘构件" 
                                    (XD::LIST->STRING w-gouzao "、") 
                                    "的实配钢筋面积小于构造配筋面积。" 
                            ) 
                    ) 
             ) 
;;;progn 
           ) 
;;;if 
           (if (/= w-jisuan-1 nil) 
             (progn (setq w-jisuan-1 (yqz::paixu w-jisuan-1)) 
                    (setq c (strcat "平面图中，边缘构件" 
                                    (XD::LIST->STRING w-jisuan-1 "、") 
                                    "的实配钢筋面积小于计算配筋面积。（位置见平面图圆圈部分）" 
                            ) 
                    ) 
             ) 
;;;progn 
           ) 
;;;if 
;;;最新、最快捷的文字标注方式，a b c d...为文字串，或nil 
           (if (not (equal (list a b c d) nil)) 
             (progn (setq point1 (getpoint "选取文字插入点：")) 
                    (setq n 0) 
                    (mapcar '(lambda (x) 
                               (setq n (1+ n)) 
                               (xdrx_text_make 
                                 (list (car point1) (- (cadr point1) (* (1- n) 700))) 
                                 (strcat (xdrx_prompt n t) "、" x) 
                                 "STANDARD" 
                                 400 
                                 (xdrx_vector_angle (getvar "wcsxdir")) 
                               ) 
                             ) 
;;;lambda(x) 
                            (vl-remove nil (list a b c d)) 
                    ) 
;;;mapcar 
                    (if (listp w-jisuan) 
                      (mapcar '(lambda (x) 
                                 (entmakex (list '(0 . "CIRCLE") 
                                                 (cons 10 (XD::Geom:Get9PT (car x) 4)) 
                                                 '(40 . 800.0) 
                                                 '(62 . 1) 
                                           ) 
                                 ) 
                               ) 
;;;lambda(x) 
                              w-jisuan 
                      ) 
;;;mapcar 
                    ) 
;;;if 
;;;(if (listp w-jisuan) 
;;;(mapcar 
;;;'(lambda(x)                                                         
;;;(entmakex (list '(0 . "CIRCLE")(cons 10 (XD::Geom:Get9PT (car x) 4)) '(40 . 800.0) '(62 . 1))) 
;;;);;;lambda(x) 
;;;w-jisuan 
;;;);;;mapcar 
;;;);;;if 
             ) 
;;;progn 
             (princ "\n比对结果均ok!") 
           ) 
           ;;if 
    ) 
;;;progn 
  ) 
;;;if 
  (setq t2 (getvar "date"))             ;记录结束时间t2 
  (princ (menucmd (strcat "M=$(edtime," 
                          (rtos (- t2 t1) 2 16) 
                          ",HH:MM:SS:MSEC)" 
                  ) 
         ) 
  ) 
;;;显示时间 
  (xdrx_end) 
  (setvar "CMDECHO" 1) 
  (setvar "osmode" 1) 
  (princ) 
) 
;;;defun 
 
;;;*********************************************************************** 
 
 
;;;以下为自定义函数 
 
(defun XD::Geom:Get9PT (e index / box) 
  (setq box (XD::Geom:9pt e)) 
  (nth index box) 
) 
 
(defun yqz::paixu (lst / x1 x2) 
;;;排序函数，用于结果中，BZ的排序 
  (vl-sort lst 
           '(lambda (x1 x2) 
              (< (atoi (xd::string:regexpr "[^0-9]" x1 "" "")) 
                 (atoi (xd::string:regexpr "[^0-9]" x2 "" "")) 
              ) 
            ) 
;;;lambda 
  ) 
;;;vl-sort lst         
) 
;;;defun 
 
 
;;;函数功能：用正则法则进行查找替换，去掉字符串中的*及（）、()中的内容，括号内带有字母及数字时，有问题。 
(defun yqz::format (a) 
  (xd::string:regexpr "[^Y|GBZ\\-0-9]" a "" "") 
) 
;;;defun 
 
(defun yqz::format1 (a) (xd::string:regexpr " " a "" "")) 
;;;defun 
 
 
 
 
(defun yqz::list:dup (lst / e lst1) 
  (while (setq e (car lst)) 
    (if (and (member e (setq lst (cdr lst))) (not (member e lst1))) 
      (setq lst1 (cons e lst1)) 
    ) 
;;;if 
  ) 
;;;if 
  (reverse lst1) 
) 
;;;defun 
 
(defun yqz::list:dup-1 (lst1 lst2 / e lst3) 
;;;比对lst1是否均在lst2中 
  (while (setq e (car lst1)) 
    (if (and (not (member e lst2)) (not (member e lst3))) 
      (setq lst3 (cons e lst3)) 
    ) 
;;;if 
    (setq lst1 (cdr lst1)) 
  ) 
;;;while 
  (reverse lst3) 
) 
;;;defun 
 
;;;以下函数适用于详图 
;;;_________________________________________________________________________________________________________________ 
(defun yqz::pickset:xt (ss / x a b c) 
  (mapcar '(lambda (x) 
             (setq a (yqz::format1 
                       (XD::Pickset:PolyFence2 x '((0 . "TEXT") (1 . "*BZ*"))) 
                     ) 
             ) 
             (setq b (atoi (XD::Pickset:PolyFence2 
                             x 
                             '((0 . "TEXT") (8 . "0-实配钢筋面积")) 
                           ) 
                     ) 
             ) 
             (setq c (atoi (XD::Pickset:PolyFence2 
                             x 
                             '((0 . "TEXT") (8 . "0-构造钢筋面积")) 
                           ) 
                     ) 
             ) 
             (list x a b c) 
           ) 
;;;lambda(x) 
          (xdrx_pickset->ents ss) 
  ) 
;;;mapcar 
) 
;;;defun 
 
 
(defun XD::Pickset:PolyFence2 (e fillter / pts pt1 pt3 ss1 name) 
;;;e为边缘构件实体的图元名；fillter为条件，同ssget 
  (if (setq pts (xdrx_entity_box e)) 
;;;取得e实体的四点包围盒。 
    (progn (setq pt1 (offset-2 (car pts)) 
;;;将做左下角点往左偏移2700，往下偏移5400 
                 pt3 (caddr pts) 
;;;取右上角点 
           ) 
;;;setq 
           (setq ss1 (ssget "w" pt1 pt3 fillter)) 
;;;选取满足条件的选择集，w选择 
           (setq name (XD::Obj:DXF (car (xdrx_pickset->ents ss1)) 1)) ;选择集转实体表，并取出名称。 
    ) 
;;;progn 
  ) 
;;;if 
  name 
) 
;;;defun 
 
(defun offset-2 (pt) 
;;;将点的x坐标左移2700，y坐标下移5400mm，适应于pkpm 
  (setq pt (subst (- (car pt) 2700) (car pt) pt) 
        pt (subst (- (cadr pt) 5400) (cadr pt) pt) 
  ) 
;;;setq 
) 
;;;defun 
 
 
;;;******************************************************************************************************************************** 
;;;以下函数的结果可能是表，也可能是nil。此函数仅对平面图中的构件其作用 
;;;参数：ss-绿色边缘构件复线框选择集，ss-a 平面图中，边缘构件名称选择集 
;;;返回结果：（边缘构件复线框图元名 边缘构件名称 计算配筋值） 
;;;测试用时：0.299s 
(defun yqz::pickset:shiti (ss ss-a / x lst t1 t2) 
;;;形成只有“计算配筋”项的表，格式：（边框图元名 引线图元名 计算配筋） 
;;;不是计算配筋控制的，均去掉了，简化与详图实配钢筋的比对进程。 
  (vl-remove nil 
             (mapcar '(lambda (x) 
                        (setq lst (XD::Pickset:PolyFence1 x)) 
                        (if (/= (caddr lst) nil) 
                          (list (car lst) 
                                (yqz::format (yqz::format:aaa (cadr lst) ss-a)) 
                                (yqz::jisuanpeijin (caddr lst) (last lst)) 
                          ) 
                          nil 
                        ) 
                        ;;if 
                      ) 
;;;lambda 
                     (xdrx_pickset->ents ss) 
             ) 
;;;mapcar 
  ) 
;;;vl-remove nil 
) 
;;;defun 
 
 
(defun XD::Pickset:PolyFence1 (e / pts pt1 pt3 pts-1 ss1 ss2 ss3 ss-a) 
;;;e为边缘构件实体的图元名；ss_BZ为边缘构件编号选择集 
  (xdrx_ucson) 
  (if (setq pts (xdrx_entity_box e)) 
;;;取得e实体的四点包围盒。 
    (progn (setq pt1 (cadr pts) 
                 pt3 (offset-1 (last pts)) 
;;;此点y坐标上提200mm 
           ) 
;;;setq 
           (setq pts-1 (xdrx_getsamplept e)) 
           (setq ss1 (ssget "c" 
                            pt1 
                            pt3 
                            '((0 . "text") (62 . 2) (1 . "计算配筋*")) 
                     ) 
           ) 
;;;计算配筋选择集 
           (setq ss2 (ssget "c" 
                            pt1 
                            pt3 
                            '((0 . "text") (62 . 7) (1 . "构造配筋*")) 
                     ) 
           ) 
;;;构造配筋选择集 
           (setq ss3 (ssget "f" 
                            pts-1 
                            '((0 . "LINE") (67 . 0) (8 . "S_EDGEMEMBERTXT")) 
                     ) 
           ) 
;;;f选择与边缘框相交的直线到选择集中 
           (setq ss-a (list e (car (xdrx_pickset->ents ss3)) ss1 ss2)) 
;;;形成表 (边缘构件边框图元名 斜直线图元名 计算配筋选择集名 构造配筋选择集名) 
    ) 
;;;progn 
  ) 
;;;if 
  (xdrx_ucsoff) 
  ss-a 
) 
;;;defun 
 
(defun offset-1 (pt) 
;;;将点的y坐标上提200mm，适应于pkpm 
  (setq pt (subst (+ (cadr pt) 200) (cadr pt) pt)) 
) 
;;;defun 
 
;;;找到引线对应的边缘构件名称，并进行处理，如：括号、*等。 
(defun yqz::format:aaa (e ss-a) 
  (XD::Obj:DXF 
    (XD::Entity:NearByPnt1 
      ss-a 
      (xdrx_getpropertyvalue e "endpoint") 
    ) 
    1 
  ) 
) 
;;;defun 
 
(defun XD::Obj:DXF (e a) 
  (if (listp e) 
    (cdr (assoc a (entget (car e)))) 
    (cdr (assoc a (entget e))) 
  ) 
) 
;;;defun 
 
 
 
(defun yqz::jisuanpeijin (ss1 ss2 / a aa bb cc x y) 
  (if (not (equal ss1 nil)) 
;;;如果计算配筋选择集/=nil 
    (progn (setq aa (mapcar '(lambda (x) 
                               (XD::String:ToNum 
                                 (XD::String:MatchBetween (XD::Obj:DXF x 1) "计算配筋" "mm") 
                               ) 
                             ) 
;;;lambda(x) 
                            (xdrx_pickset->ents ss1) 
                    ) 
;;;mapcar，取出计算配筋控制的值，表的格式 
           ) 
;;;setq 
           (if (not (equal ss2 nil)) 
;;;如果白色构造配筋/=nil 
             (setq bb (mapcar '(lambda (y) 
                                 (XD::String:ToNum 
                                   (XD::String:MatchBetween (XD::Obj:DXF y 1) "构造配筋" "mm") 
                                 ) 
                               ) 
;;;lambda(y) 
                              (xdrx_pickset->ents ss2) 
                      ) 
;;;mapcar，取出构造配筋值表 
             ) 
;;;setq 
             (setq bb 0) 
           ) 
;;;if 
           (setq cc (list-n (list aa bb))) 
;;;将aa、bb表合并为一个表，并且将表元素放置到第一层 
           (setq a (apply '+ cc)) 
;;;各元素的和         
    ) 
;;;progn 
    (setq a nil) 
  ) 
;;;if 
  a 
) 
;;dedun 
 
 
;;;将表元素放置到第一层 
(defun list-n (lst / func st) 
  (defun func (lst) 
    (if (null x) 
      (setq st '()) 
    ) 
    (foreach x lst 
      (if (listp x) 
        (func x) 
        (setq st (cons x st)) 
      ) 
    ) 
    (reverse st) 
  ) 
  (func lst) 
) 
 
;;;函数：XD::Entity:NearByPnt1;;;;暂时先这样，以后版本修改为所有点与选择集一一对应最近点 
(defun XD::Entity:NearByPnt1 (el2 pt / box dis el1 pt2 pnt pnt1 x1 x2 y) 
  (if (= (type el2) 'PICKSET) 
    (setq el2 (xdrx_pickset->ents el2)) ;选择集转实体表，(<图元名: 7ff676e05a60> <图元名: 7ff676e05a50> <图元名: 7ff676e05a30>) 
  ) 
  ;;if 
  (setq el1 (mapcar '(lambda (y) 
                       (setq box (xdrx_entity_box y)) 
;;;求出四点包围盒的坐标表((6.49192e+006 -3.54352e+006 0.0) (6.49303e+006 -3.54352e+006 0.0) (6.49303e+006 -3.54314e+006 0.0) (6.49192e+006 -3.54314e+006 0.0)) 
;;;此处现在的顺序是正确的，左下角点，右下角点，右上角点，左上角点！！！ 
                       (setq pnt  (car box) 
;;; 
                             pnt1 (cadr box) 
                             pt2  (xdrx_line_nearpoint pnt pnt1 pt) 
                             dis  (distance pt pt2) 
                       ) 
;;;setq 
                       (list dis y) 
                     ) 
;;;lambda 
                    el2 
            ) 
;;;mapcar 
  ) 
;;;setq 
  (cadar (vl-sort el1 
                  '(lambda (x1 x2) (< (car x1) (car x2))) 
;;;lambda 
         ) 
;;;vl-sort el1 
  ) 
;;;cadar 
) 
;;;defun 
;;;************************************************************************************************************************

marting · 发表于 2018-5-9 14:56:59

dyjwyqz5221 发表于 2018-5-9 17:24
我测试了，就是 (setq ss1 (ssget "w" pt1 pt3 fillter))这里取不出值来。

首先，确定下PT1,PT2，FILLTER是否有值。
如果有，在当前显示下，自己手工用上面代码求下选择集，看是否有
C构建选择集最好用WP，给个矩形表去求选择集。

dyjwyqz5221 · 发表于 2018-5-9 15:19:17

这是测试的t3-cad文件、字体,测试过程中还发现一个问题：用zoom缩小后，程序可以运行，放大后，就出现：参数类型错误: lentityp nil
。

newer · 发表于 2018-5-9 15:36:09

dyjwyqz5221 发表于 2018-5-9 15:19
这是测试的t3-cad文件、字体,测试过程中还发现一个问题：用zoom缩小后，程序可以运行，放大后，就出现：参 ...

程序太长了，简单说下，
1、你程序做什么的。

2、你怎么编译的

newer · 发表于 2018-5-9 15:38:05

newer 发表于 2018-5-9 15:36
程序太长了，简单说下，
1、你程序做什么的。

而且，除了XDRX API和通用LISP函数库，还有很多如 yqz::pickset:shiti 这样的函数没给源码，程序执行不了。

dyjwyqz5221 · 发表于 2018-5-9 15:48:55

自己构造的源码都在上面，主要功能是比对平面图的计算配筋与详图的实配钢筋、构造配筋进行比对，将结果标注在cad图上，并且将平面图中实配钢筋不足的构件用红色圆圈标志出来，还有个功能就是比对平面图与详图构件名称是否相对应。

dyjwyqz5221 · 发表于 2018-5-9 15:54:02

用这个程序编译的，打算编译成*.vlx文件。

dyjwyqz5221 · 发表于 2018-5-9 15:57:34

刚才测试了下，哪些自定义函数打包后编译没问题，问题出在主程序上，现在仅有一个错误了，“参数值错误: 非负: -1”

dyjwyqz5221 · 发表于 2018-5-9 15:58:41

刚才测试了下，那些自定义函数打包后编译没问题，问题出在主程序上，现在仅有一个错误了，“参数值错误: 非负: -1”

dyjwyqz5221 · 发表于 2018-5-9 16:10:11

缩放时，程序出问题是下面这个函数处，我用的是wcs坐标系，是否与这有关系？？？

(defun XD::Pickset:PolyFence2 ( e fillter / pts pt1 pt3 ss1 name );;;e为边缘构件实体的图元名；fillter为条件，同ssget
    (if (setq pts (xdrx_entity_box e));;;取得e实体的四点包围盒。
(progn
(setq pt1 (offset-2 (car pts));;;将做左下角点往左偏移2700，往下偏移5400
pt3 (caddr pts);;;取右上角点
);;;setq
(setq ss1 (ssget "w" pt1 pt3 fillter));;;选取满足条件的选择集，w选择
(setq name (XD::Obj:DXF (car (xdrx_pickset->ents ss1)) 1));选择集转实体表，并取出名称。
);;;progn
    );;;if
    name
);;;defun

(defun offset-2 ( pt );;;将点的x坐标左移2700，y坐标下移5400mm，适应于pkpm
(setq pt (subst (- (car pt) 2700) (car pt) pt)
pt (subst (- (cadr pt) 5400) (cadr pt) pt)
);;;setq
);;;defun

newer · 发表于 2018-5-9 16:23:40

dyjwyqz5221 发表于 2018-5-9 16:10
缩放时，程序出问题是下面这个函数处，我用的是wcs坐标系，是否与这有关系？？？

局部代码看不清楚，你说下要缩放什么，我看有什么合适的函数

点表偏移OFFSET函数可以用：
xdrx_points_offset

曲线实体偏移可以用
xdrx_curve_offset

dyjwyqz5221 · 发表于 2018-5-9 17:03:35

这是我要实现的局部功能 %F[$JYA4(U4XEY0I[{]QT.png

dyjwyqz5221 · 发表于 2018-5-9 17:05:37

不能四周都偏移，否则可能将其他构件的数据包括进来

dyjwyqz5221 · 发表于 2018-5-9 17:06:57

我说的缩放指屏幕缩放，屏幕放大时，程序就出问题了，缩小时很正常。

dyjwyqz5221 · 发表于 2018-5-9 17:09:06

XD::Pickset:PolyFence2函数是在开源函数库XD::Pickset:PolyFence的基础上修改的，我用的坐标系与wcs一致，所以就没有转换，转换坐标也一样。

账号		自动登录	找回密码
密码			立即注册

[已解决] 本人菜鸟，最近刚做了个lisp程序，在编译时，出现错误，请给我指出错误

最佳答案

点评

点评

点评

浏览过的版块