正交多段线lisp。。。。一

Utah_Indie · 发表于 2022-7-6 10:00:49

我开始开发一个lisp，它将检查图形中的所有多段线的x或y坐标是否相等，并将每个不符合标准的多段线的颜色从“bylayer”更改为红色。

我在按顺序遍历每个对象以及当前对象中每个顶点的循环比较方面遇到了问题。

我要再次尝试的是检查建筑类型图形中的所有多段线是否为正方形，并提醒哪些不是正方形。

我不是Lisp程序的专家，请容忍我。如果你想很好地纠正我的语法，或者指导我犯了什么大错——甚至更好。
谢谢
Randy（第一个职位）

目前为止的代码：

（defun C:perp（）

（defun A1（）

（setq eFilter（列表（cons 0“多段线”））；列表中的实体名称
（ssget“X”eFilter）
); 端部defun A1
（defun B1（）
（setq eLen（长度eList））；获取列表的长度
); 结束defun b1
（defun D1（）
（setq Lwn 0）；变量初始定义
（setq e 0）；同上
（重复eLen；重复实体列表的长度）
（setq e1（car（n n e）））
（如果
（=e1 10）
（程序
（ERPI）
（普林斯（cdr（nth n e）））
); 关闭程序

); 如果关闭，则关闭
（setq Lwn（+1 Lwn））
（setq a（cdr（nth n e）））
); 关闭重复
); 关闭D1
（defun Esub（）
（trace Esub）
（setq坐标（长度e1））
); 关闭Esub
（重复坐标；重复坐标列表的长度
（defun G1（）；将坐标解析为xa ya xb yb
（setq a（cdr（n次坐标e）））
（setq b（cdr（第n个（+coordLen 1）（+e 1）））
) ; G1端
;---------------开始子程序H1----------------------
（defun H1（）
（setq xa（a车））
（setq ya（cadr a））
（setq xb（b车））
（setq yb（cadr b））
); 关闭H1
（defun H2（）
（=0（-xa xb））
（=0（-ya-yb））
（T（命令“chprop”“p”“c”“red”“））
); 关闭h2
); 关闭重复
)

David Bethel · 发表于 2022-7-6 10:10:51

你确定所有的实体都是旧式的重多边形，而不是LWpolyline吗？必须以两种不同的方式处理它们。此外，您还需要确定比较的容差。对于大多数此类计算，（=）过于严格-大卫

David Bethel · 发表于 2022-7-6 10:22:14

如果您确定点被捕捉到相当高的公差，这可能是点列表的基本测试：

copy


[b][color=BLACK]([/color][/b]setq pl '[b][color=FUCHSIA]([/color][/b][b][color=NAVY]([/color][/b]0 1 0[b][color=NAVY])[/color][/b] [b][color=NAVY]([/color][/b]0 4 0[b][color=NAVY])[/color][/b] [b][color=NAVY]([/color][/b]0 6 0[b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b][b][color=BLACK])[/color][/b]
[b][color=BLACK]([/color][/b]defun ortholst [b][color=FUCHSIA]([/color][/b]pl / xvals yvals xeq yeq[b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]setq xvals [b][color=NAVY]([/color][/b]mapcar 'car pl[b][color=NAVY])[/color][/b]
       yvals [b][color=NAVY]([/color][/b]mapcar 'cadr pl[b][color=NAVY])[/color][/b]
       xeq [b][color=NAVY]([/color][/b]apply '= xvals[b][color=NAVY])[/color][/b]
       yeq [b][color=NAVY]([/color][/b]apply '= yvals[b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]or xeq yeq[b][color=FUCHSIA])[/color][/b][b][color=BLACK])[/color][/b]
[b][color=BLACK]([/color][/b]prin1 [b][color=FUCHSIA]([/color][/b]ortho_lst pl[b][color=FUCHSIA])[/color][/b][b][color=BLACK])[/color][/b]

如果所有X或Y值都相等，则返回T-大卫

Utah_Indie · 发表于 2022-7-6 10:34:57

谢谢大卫。它们确实需要捕捉，或者在导入到ESRI GIS平台时，将在任何空白区域创建一个小“地块”。我想我可能可以单独导航测试LWPolyline或POLYLINE对象。你知道我的循环在哪里崩溃了吗？我可能有30个左右的顶点来评估对象。此外，我可能需要为第一个测试复制第一个坐标，因为n+1=0是一个笨拙的第一个比较，如果这有任何意义的话。

David Bethel · 发表于 2022-7-6 10:39:13

我想我明白你想做什么了。

这可能是一个起点：

copy


[b][color=BLACK]([/color][/b]defun massoc [b][color=FUCHSIA]([/color][/b]key alist / x nlist[b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]foreach x alist
   [b][color=NAVY]([/color][/b]if [b][color=MAROON]([/color][/b]eq key [b][color=GREEN]([/color][/b]car x[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
       [b][color=MAROON]([/color][/b]setq nlist [b][color=GREEN]([/color][/b]cons [b][color=BLUE]([/color][/b]cdr x[b][color=BLUE])[/color][/b] nlist[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]reverse nlist[b][color=FUCHSIA])[/color][/b][b][color=BLACK])[/color][/b]
[b][color=BLACK]([/color][/b]defun ortholst [b][color=FUCHSIA]([/color][/b]pl / xvals yvals xeq yeq[b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]setq xvals [b][color=NAVY]([/color][/b]mapcar 'car pl[b][color=NAVY])[/color][/b]
       yvals [b][color=NAVY]([/color][/b]mapcar 'cadr pl[b][color=NAVY])[/color][/b]
       xeq [b][color=NAVY]([/color][/b]apply '= xvals[b][color=NAVY])[/color][/b]
       yeq [b][color=NAVY]([/color][/b]apply '= yvals[b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]or xeq yeq[b][color=FUCHSIA])[/color][/b][b][color=BLACK])[/color][/b]
[color=#8b4513];[b][color=BLACK]([/color][/b]setq pl '[b][color=FUCHSIA]([/color][/b][b][color=NAVY]([/color][/b]0 1 0[b][color=NAVY])[/color][/b] [b][color=NAVY]([/color][/b]0. 4 0[b][color=NAVY])[/color][/b] [b][color=NAVY]([/color][/b]0. 6 0[b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b][b][color=BLACK])[/color][/b][/color]
[b][color=BLACK]([/color][/b]and [b][color=FUCHSIA]([/color][/b]setq i -1
         cs [b][color=NAVY]([/color][/b]ssadd[b][color=NAVY])[/color][/b]
         ss [b][color=NAVY]([/color][/b]ssget [color=#2f4f4f]"X"[/color] '[b][color=MAROON]([/color][/b][b][color=GREEN]([/color][/b]0 . [color=#2f4f4f]"LWPOLYLINE"[/color][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
    [b][color=FUCHSIA]([/color][/b]while [b][color=NAVY]([/color][/b]setq en [b][color=MAROON]([/color][/b]ssname ss [b][color=GREEN]([/color][/b]setq i [b][color=BLUE]([/color][/b]1+ i[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
           [b][color=NAVY]([/color][/b]setq ed [b][color=MAROON]([/color][/b]entget en[b][color=MAROON])[/color][/b]
                 pl [b][color=MAROON]([/color][/b]massoc 10 ed[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
           [b][color=NAVY]([/color][/b]cond [b][color=MAROON]([/color][/b][b][color=GREEN]([/color][/b]ortholst pl[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
                 [b][color=MAROON]([/color][/b]T [b][color=GREEN]([/color][/b]ssadd en cs[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
    [b][color=FUCHSIA]([/color][/b]if cs [b][color=NAVY]([/color][/b]command [color=#2f4f4f]"_.CHPROP"[/color] cs [color=#2f4f4f]""[/color] [color=#2f4f4f]"_C"[/color] 1 [color=#2f4f4f]""[/color][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b][b][color=BLACK])[/color][/b]

这同样适用于以3-4位小数精度创建的PLINE-大卫

Utah_Indie · 发表于 2022-7-6 10:51:02

大卫，谢谢你。这看起来是一个很好的干净的解决方案。我希望我可以麻烦你一些额外的故障排除。我将您发布的最新代码粘贴到Visual Lisp控制台中，在当前图形中绘制了许多orhto和非正交闭合多段线，并运行了代码。无论正交或非正交状态如何，它都会将所有多段线变为红色。

我将代码的最后一节更改为（无效）：

（如果是cs（命令“_.CHPROP”cs”“”\u C“2”）
（命令“_.CHPROP”cs”“\u C“1”）

接下来的几行是实验性的，看看我是否可以嵌入格式等，但我添加了一些问题；以注释语句的形式查看我是否理解这些步骤

copy


[b]([/b]defun ortholst [b][color=fuchsia]([/color][/b]pl / xvals yvals xeq yeq[color=fuchsia][b])[/b] [/color][u][color=black];defines the subroutine ortholst, defines variables pl and temporarily xvals yvals xeq and yeq[/color]
[/u]  [b][color=fuchsia]([/color][/b]setq xvals [b][color=navy]([/color][/b]mapcar 'car pl[b][color=navy]) [/color][/b];[u]sets the variable xvals as a real number extracted from the first entry of the list pl[/u]        yvals [b][color=navy]([/color][/b]mapcar 'cadr pl[b][color=navy]) [/color][/b][u]; sets the variable yvals as a real number extracted from the second entry of the list pl[/u]
       xeq [b][color=navy]([/color][/b]apply '= xvals[b][color=navy])[/color][/b]
       yeq [b][color=navy]([/color][/b]apply '= yvals[b][color=navy])[/color][/b][b][color=fuchsia]) [/color][/b][u]; tests xvals and yvals for any equivalency to the other ordered pairs, thus xeq and yeq become a T/F or 1/0 value?
[/u]  [color=fuchsia][b]([/color][/b]or xeq yeq[b][color=fuchsia])[/color][/b][b][color=black]) [/color][/b][u];if either the x or y coordinate is equal then true else false[/u]
[color=#8b4513];[b][color=black]([/color][/b]setq pl '[b][color=fuchsia]([/color][/b][b][color=navy]([/color][/b]0 1 0[b][color=navy])[/color][/b] [b][color=navy]([/color][/b]0. 4 0[b][color=navy])[/color][/b] [b][color=navy]([/color][/b]0. 6 0[b][color=navy])[/color][/b][b][color=fuchsia])[/color][/b][b][color=black])[/color][/b][/color]
[b][color=black]([/color][/b]and [b][color=fuchsia]([/color][/b]setq i -1  [u];and, returns true if all conditions are true, else false, what are all the 'and' comparisons, and we are still under the 'or' xeq yeq comparison for true condition aren't we?
[/u]          cs [b][color=navy]([/color][/b]ssadd[b][color=navy]) [/color][/b][u];not sure what cs is as a variable or first operator under the 'and' function[/u]
         ss [b][color=navy]([/color][/b]ssget [color=#2f4f4f]"X"[/color] '[b][color=maroon]([/color][/b][b][color=green]([/color][/b]0 . [color=#2f4f4f]"LWPOLYLINE"[/color][b][color=green])[/color][/b][b][color=maroon])[/color][/b][b][color=navy])[/color][/b][b][color=fuchsia]) [/color][/b][u];also not sure what the ss argument does[/u]
    [b][color=fuchsia]([/color][/b]while [b][color=navy]([/color][/b]setq en [b][color=maroon]([/color][/b]ssname ss [b][color=green]([/color][/b]setq i [b][color=blue]([/color][/b]1+ i[b][color=blue])[/color][/b][b][color=green])[/color][/b][b][color=maroon])[/color][/b][b][color=navy]) [/color][/b][u];looping through coordinate pairs?[/u]
           [b][color=navy]([/color][/b]setq ed [b][color=maroon]([/color][/b]entget en[b][color=maroon])  [/color][/b]
                 pl [b][color=maroon]([/color][/b]massoc 10 ed[b][color=maroon])[/color][/b][b][color=navy]) [/color][/b][u];runs the subroutine massoc for each of the number 'ed' coordinate pairs?[/u]
           [b][color=navy]([/color][/b]cond [b][color=maroon]([/color][/b][b][color=green]([/color][/b]ortholst pl[b][color=green])[/color][/b][b][color=maroon]) [/color][/b][u];condition test of 'and' comparison?[/u]
                 [b][color=maroon]([/color][/b]T [b][color=green]([/color][/b]ssadd en cs[b][color=green])[/color][/b][b][color=maroon])[/color][/b][b][color=navy])[/color][/b][b][color=fuchsia]) [/color][/b][u];not sure what the effect of this code is, explanation would help me
[/u]     [b][color=fuchsia]([/color][/b]if cs [b][color=navy]([/color][/b]command [color=#2f4f4f]"_.CHPROP"[/color] cs [color=#2f4f4f]""[/color] [color=#2f4f4f]"_C"[/color] 1 [color=#2f4f4f]""[/color][b][color=navy])[/color][/b][b][color=fuchsia])[/color][/b][b][color=black]) [/color][/b][u];I understand the basics of an if argument, but I am guessing that the syntax "(if cs (command..." means that "cs" is a test comparison? such as (setq cs(= 1 0))[/u]
[u]

我太感谢你了。你真是太客气了。
兰迪

David Bethel · 发表于 2022-7-6 10:56:16

首先，感谢您对理解代码的兴趣和明显的努力！

对您的评论的一些评论：

copy


; [color="red"]I added a command line call c:orth-lwp in the updated version[/color]
(defun ortholst (pl / xvals yvals xeq yeq) ;defines the subroutine ortholst, 
     ; [color="red"]declares the aurgment pl[/color]
     ; d[color="red"]efines variables xvals yvals xeq and yeq as local to this function only[/color]
 
 (setq xvals (mapcar 'car pl) ; sets the variable xvals as a [color="red"]list of [/color]real numbers extracted from the first [color="red"]atom[/color] of the list pl 
         yvals (mapcar 'cadr pl) ; sets the variable yvals as a [color="red"]list of[/color] real numbers extracted from the second [color="red"]atom[/color] of the list pl
       xeq (apply '= xvals)
       yeq (apply '= yvals)) 
; tests xvals and yvals atoms for all equivalency, thus xeq and yeq [color="red"]are bound to T / nil[/color]
; [color="red"]here is where the problem may be   The = call returns T ONLY if all of the atom are exactly equal.  
; Point values are stored as REAL numbers and autocad uses 15 significant digits.
; If all of the the points are not exactly equal, then it will reurn nil  [/color]
 (or xeq yeq)) ;[color="red"]if either the x or y coordinates are equal then return T else nil[/color]
 
(and (setq i -1  ;and, [color="red"]evaluate all expressions until a nil return is encountered[/color]
; what are all the 'and' comparisons
[color="red"]; the color helps here. All of the magenta tests in the original ( blue in the updated ) post are evaluated
; the last call will return nil either way, but it dosen't matter as it is the last espression [/color]
, and we are still under the 'or' xeq yeq comparison for true condition aren't we? [color="red"]No[/color]
         cs (ssadd) ;[color="red"]create an empty PICKSET named cs ( ChangeSet )[/color]
         ss (ssget '((0 . "X" LWPOLYLINE")))) ; [color="red"]Create a PICKSET named ss of all LWPOLYLINEs in the drawing [/color]
    (while (setq en (ssname ss (setq i (1+ i)))) ;looping through a PICKESET
           (setq ed (entget en)  ; [color="red"]Get the entity definition[/color]
                 pl (massoc 10 ed)) ; [color="red"]extract all group 10 point values from the entity definition[/color]
           (cond ((ortholst pl)) ; [color="red"]Conditional test : If the subroutine othro_test returns T, Then do nothing [/color]
                 (T (ssadd en cs)))) ; [color="red"]Elseif, then add the entity to the change set cs[/color]
    (if cs (command "_.CHPROP" cs "" "_C" 1 ""))) ; [color="red"]if the changes set is bound to a value, then issue the CHPROP command[/color]
 ; [color="red"]I changed this test to test if the length of  set is greater than 0 for clarity[/color]

更新的例程：

copy


[b][color=BLACK]([/color][/b]defun c:orth-lwp [b][color=FUCHSIA]([/color][/b]/ i cs ss en ed pl[b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]defun massoc [b][color=NAVY]([/color][/b]key alist / nlist[b][color=NAVY])[/color][/b]
   [b][color=NAVY]([/color][/b]foreach x alist
     [b][color=MAROON]([/color][/b]if [b][color=GREEN]([/color][/b]eq key [b][color=BLUE]([/color][/b]car x[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
         [b][color=GREEN]([/color][/b]setq nlist [b][color=BLUE]([/color][/b]cons [b][color=RED]([/color][/b]cdr x[b][color=RED])[/color][/b] nlist[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
   [b][color=NAVY]([/color][/b]reverse nlist[b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]defun ortholst [b][color=NAVY]([/color][/b]pl / xvals yvals xeq yeq[b][color=NAVY])[/color][/b]
   [b][color=NAVY]([/color][/b]setq xvals [b][color=MAROON]([/color][/b]mapcar 'car pl[b][color=MAROON])[/color][/b]
         yvals [b][color=MAROON]([/color][/b]mapcar 'cadr pl[b][color=MAROON])[/color][/b]
         xeq [b][color=MAROON]([/color][/b]apply '= xvals[b][color=MAROON])[/color][/b]
         yeq [b][color=MAROON]([/color][/b]apply '= yvals[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
   [b][color=NAVY]([/color][/b]or xeq yeq[b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]and [b][color=NAVY]([/color][/b]setq i -1
           cs [b][color=MAROON]([/color][/b]ssadd[b][color=MAROON])[/color][/b]
           ss [b][color=MAROON]([/color][/b]ssget [color=#2f4f4f]"X"[/color] '[b][color=GREEN]([/color][/b][b][color=BLUE]([/color][/b]0 . [color=#2f4f4f]"LWPOLYLINE"[/color][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
      [b][color=NAVY]([/color][/b]while [b][color=MAROON]([/color][/b]setq en [b][color=GREEN]([/color][/b]ssname ss [b][color=BLUE]([/color][/b]setq i [b][color=RED]([/color][/b]1+ i[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
             [b][color=MAROON]([/color][/b]setq ed [b][color=GREEN]([/color][/b]entget en[b][color=GREEN])[/color][/b]
                   pl [b][color=GREEN]([/color][/b]massoc 10 ed[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
             [b][color=MAROON]([/color][/b]cond [b][color=GREEN]([/color][/b][b][color=BLUE]([/color][/b]ortholst pl[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
                   [b][color=GREEN]([/color][/b]T [b][color=BLUE]([/color][/b]ssadd en cs[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
      [b][color=NAVY]([/color][/b]if [b][color=MAROON]([/color][/b]> [b][color=GREEN]([/color][/b]sslength cs[b][color=GREEN])[/color][/b] 0[b][color=MAROON])[/color][/b]
          [b][color=MAROON]([/color][/b]command [color=#2f4f4f]"_.CHPROP"[/color] cs [color=#2f4f4f]""[/color] [color=#2f4f4f]"_C"[/color] 1 [color=#2f4f4f]""[/color][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]prin1[b][color=FUCHSIA])[/color][/b][b][color=BLACK])[/color][/b]

我的测试台dwg文件已附上。

我希望这有帮助。随时欢迎回到低谷-大卫

顺便说一句，你是在测试一个向量样条线，而不是一个矩形？？？主要区别：冲击：

PS PS看起来你精通一门计算机语言，顺便说一句，在Autolisp中，我们没有错。在大多数语言中，FALSE不是TRUE。我们有零，这是一个空列表。
所有这些都返回T：

copy


(equal nil '())
(eq nil '())
(= nil '())
(not nil)
(null nil)
(listp nil)

测验图纸

David Bethel · 发表于 2022-7-6 11:05:35

Randy，

在重读了第#6篇文章之后，我现在猜你实际上是在测试封闭的矩形形状。

要测试正交闭合多段线：

[code]（defun c:orth lwr（/i cs ss en ed pl（defun massoc（key LIST/nlist）[/color b]（foreach x LIST[color=褐红色]（[/color b]if]（eq键（汽车x（setq nlist（cons（cdr x）nlist[color=BLUE b][b/color反面列表[/color（defun orthorct（pl/tmp tst（cons（last pl）pltst T[color=海军蓝）[color=海军蓝]（重复（length pl）（如果（不是（等于（rem color=PURPLE]（角度（汽车tmp）（]cadr tmp（*pi 0.5]]0 1e-8]（setq tst nil]]（setq tmp（cdr tmp]（和（setq i-1 cs（ssadd）ss（/colorssget“X”'[color=绿色]（[color=蓝色]（0。“LWPOLYLINE”[color=蓝色]（-4。”

[编程交流] 正交多段线lisp。。。。一

发表回复

精选推荐