社区 › Auto Lisp › 找不到线的中点

Grrr 发表于 2022-7-5 17:48:23

找不到线的中点

大家好，
今天，我尝试了李Mac的一些编码风格——通过组合cond和not函数。我想我理解他这样做的原因——在代码中切换和找到断点很容易。在我的例子中是这样的：
Midpoint of the line not found.
问题是我不明白它出了什么问题，所以我运行了VLIDE并观察了一些变量：
LOG Watch
...............
MIDPT = (2377.57 -1262.93 0.0)
ENDPT2 = (3345.54 -1666.0 0.0)
ENDPT1 = (1409.6 -859.868 0.0)
LINE = ((1409.6 -859.868 0.0) (3345.54 -1666.0 0.0))
ENTITYTYPE = "LWPOLYLINE"
ENT = (<Entity name: 7ff6d2304ea0> (1812.88 -1048.75 0.0))
CENSSBOX = (2556.4 1934.71 0.0)
SSBOX = ((1891.74 1157.88 0.0) (3221.06 2711.53 0.0))
...............
基本上，我试图将SS从“Censbox”移动到“MIDPT”点变量。我知道我有两种不同的方法来找到这些点。
事实上，我单独测试了变量-使用POINT命令我成功地绘制了它们的正确位置-但结合在一起用于move命令密码告诉我要迷路。
这里是顺便说一句：
; Moves selection from its center to the midpoint of the picked LINE or PLINE's segment

(defun c:test ( / pdm ss ssbox censsbox ent entitytype line endpt1 endpt2 midpt )
(vl-load-com)
(setq pdm (getvar 'PDMODE))
(setvar 'PDMODE 35)
(while
        (cond
                ( (not (and (princ "\nSelect objects to move") (setq ss (ssget "_:L"))))
                        (princ "\nNothing selected.")
                )
                ( (not (setq ssbox (LM:ssboundingbox ss)))
                        (princ "\nUnable to calculate bounding box for selection.")
                )
                ( (not (setq censsbox (apply 'mapcar (cons '(lambda ( a b ) (/ (+ a b) 2.0)) ssbox)) ))
                        (princ "\nUnable to find bounding box's centroid.")
                )
                ( (not (setq ent (entsel "\nPick a line or a polyline's segment")))
                        (princ "\nMissed.. Try again!")
                )
                ( (not (setq entitytype (cdr (assoc 0 (entget (car ent))))) )
                        (princ "\nEntitytype not found.")
                )
                (
                        (progn
                                (setq line (get_ends ent))
                                (setq endpt1 (carline))
                                (setq endpt2 (cadrline))
                                (setq midpt (mid endpt1 endpt2))
                        )
                        (princ "\nMidpoint of the line not found.")
                )
                (
                        (progn
                                (vl-cmdf "_.move" ss ""
                                        "_non" censsbox
                                        "_non" midpt
                                )
                                (princ (strcat "\nThis time you picked \"" entitytype "\" entity! " ))
                        )
                )
        );cond
        (setvar 'PDMODE pdm)
);while
(princ)
)

; (command "_.POINT" endpt1 )
; (command "_.POINT" endpt2 )
; (command "_.POINT" censsbox )
; (command "_.POINT" midpt )


(defun mid (p1 p2)
(mapcar '(lambda (x1 x2) (/ (+ x1 x2) 2.0)) p1 p2)
)

; Stefan BMR
(defun get_ends (e / o p p1 p2 b)
(setq o(car e)
        b(eq (cdr (assoc 0 (entget o))) "LWPOLYLINE")
        p(vlax-curve-getparamatpoint
                o
                (vlax-curve-getclosestpointto o (trans (cadr e) 1 0))
        )
        p1 (if b
                (fix p)
                (vlax-curve-getstartparam o)
        )
        p2 (if b
                (1+ p1)
                (vlax-curve-getendparam o)
        )
)
(if (> (- p2 p) (- p p1))
        (list
                (trans (vlax-curve-getpointatparam o p1) 0 1)
                (trans (vlax-curve-getpointatparam o p2) 0 1)
        )
        (list
                (trans (vlax-curve-getpointatparam o p2) 0 1)
                (trans (vlax-curve-getpointatparam o p1) 0 1)
        )
)
)

(defun LM:listmid ( lst )
((lambda ( n ) (mapcar '(lambda ( x ) (/ x n)) (apply 'mapcar (cons '+ lst)))) (length lst))
)

;; Selection Set Bounding Box-Lee Mac
;; Returns a list of the lower-left and upper-right WCS coordinates of a
;; rectangular frame bounding all objects in a supplied selection set.
;; s - Selection set for which to return bounding box

(defun LM:ssboundingbox ( s / a b i m n o )
(repeat (setq i (sslength s))
        (if
                (and
                        (setq o (vlax-ename->vla-object (ssname s (setq i (1- i)))))
                        (vlax-method-applicable-p o 'getboundingbox)
                        (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list o 'a 'b))))
                )
                (setq m (cons (vlax-safearray->list a) m)
                        n (cons (vlax-safearray->list b) n)
                )
        )
)
(if (and m n)
        (mapcar '(lambda ( a b ) (apply 'mapcar (cons a b))) '(min max) (list m n))
)
)

Lee Mac 发表于 2022-7-5 17:52:34

提示：（setq midpt（mid endpt1 endpt2））将返回一个非nil值，以验证cond test表达式。

Grrr 发表于 2022-7-5 17:56:23

嗨，李，
我真的不理解这个问题，在“Log Watch”上我清楚地看到“midpt”变量返回（2377.57-1262.93 0.0）。
我假设这是一个点坐标。
 
编辑：
我发现了问题。。。
                        (
                        (not
                                (progn
                                        (setq line (get_ends ent))
                                        (setq endpt1 (carline))
                                        (setq endpt2 (cadrline))
                                        (setq midpt (mid endpt1 endpt2))
                                )
                        )
                        (princ "\nMidpoint of the line not found.")
                )
我需要仔细研究cond的工作原理。
我在entsel部分的第二个问题上卡住了，我要试一下。

David Bethel 发表于 2022-7-5 18:00:17

如果（cond）测试序列中的任何测试具有非零返回，（cond）停止评估其余的条件测试。即，如果设置了midpt，则永远不会执行move命令
 
 
-大卫

Grrr 发表于 2022-7-5 18:02:14

谢谢David，
所以整个过程都是这样的吗
(cond
( (not (Stuff to do #1))) ; evaluate arguments from user and continue if TRUE next to #2
        (princ "\nStuff to do #1 are not done, do them to continiue")
)
( (not (Stuff to do #2))) ; evaluate arguments from user and continue if TRUE next to #3
        (princ "\nStuff to do #2 are not done, do them to continiue")
)
( (not (Stuff to do #3))) ; evaluate arguments from user and continue if TRUE next for the code to compute
        (princ "\nStuff to do #3 are not done, do them to continiue")
)
( (not (We got everything we need from Stuff #1, #2 and #3, now the code does its job... )) ; every argument has been evaluated, the code proceeds with the results
        (princ "\nEverything is provided for the code, but it failed!")
)
);cond
 
以下是固定代码（这是一种做法）：
; Moves selection from its center to the midpoint of the picked LINE or PLINE's segment

(defun c:test ( / pdm ss ssbox censsbox ent entitytype line endpt1 endpt2 midpt )
(vl-load-com)
(setq pdm (getvar 'PDMODE))
(setvar 'PDMODE 35)
(while
        (cond
                ( (not (and (princ "\nSelect objects to move") (setq ss (ssget "_:L"))))
                        (princ "\nNothing selected.")
                )
                ( (not (setq ssbox (LM:ssboundingbox ss)))
                        (princ "\nUnable to calculate bounding box for selection.")
                )
                ( (not (setq censsbox (apply 'mapcar (cons '(lambda ( a b ) (/ (+ a b) 2.0)) ssbox)) ))
                        (princ "\nUnable to find bounding box's centroid.")
                )
                ( (not (while (not (setq ent (entsel "\nPick a line or a polyline's segment"))) ent (princ "\nMissed.. Try again!")) )
                )
                ( (not (setq entitytype (cdr (assoc 0 (entget (car ent))))) )
                        (princ "\nEntitytype not found.")
                )
                (
                        (not
                                (progn
                                        (setq line (get_ends ent))
                                        (setq endpt1 (carline))
                                        (setq endpt2 (cadrline))
                                        (setq midpt (mid endpt1 endpt2))
                                )
                        )
                        (princ "\nMidpoint of the line not found.")
                )
                (
                        (progn
                                (vl-cmdf "_.move" ss ""
                                        "_non" censsbox
                                        "_non" midpt
                                )
                                (princ (strcat "\nThis time you picked \"" entitytype "\" entity! " ))
                        )
                )
        );cond
        (setvar 'PDMODE pdm)
);while
(princ)
)

; (command "_.POINT" endpt1 )
; (command "_.POINT" endpt2 )
; (command "_.POINT" censsbox )
; (command "_.POINT" midpt )


(defun mid (p1 p2)
(mapcar '(lambda (x1 x2) (/ (+ x1 x2) 2.0)) p1 p2)
)

; Stefan BMR
(defun get_ends (e / o p p1 p2 b)
(setq o(car e)
        b(eq (cdr (assoc 0 (entget o))) "LWPOLYLINE")
        p(vlax-curve-getparamatpoint
                o
                (vlax-curve-getclosestpointto o (trans (cadr e) 1 0))
        )
        p1 (if b
                (fix p)
                (vlax-curve-getstartparam o)
        )
        p2 (if b
                (1+ p1)
                (vlax-curve-getendparam o)
        )
)
(if (> (- p2 p) (- p p1))
        (list
                (trans (vlax-curve-getpointatparam o p1) 0 1)
                (trans (vlax-curve-getpointatparam o p2) 0 1)
        )
        (list
                (trans (vlax-curve-getpointatparam o p2) 0 1)
                (trans (vlax-curve-getpointatparam o p1) 0 1)
        )
)
)

(defun LM:listmid ( lst )
((lambda ( n ) (mapcar '(lambda ( x ) (/ x n)) (apply 'mapcar (cons '+ lst)))) (length lst))
)

;; Selection Set Bounding Box-Lee Mac
;; Returns a list of the lower-left and upper-right WCS coordinates of a
;; rectangular frame bounding all objects in a supplied selection set.
;; s - Selection set for which to return bounding box

(defun LM:ssboundingbox ( s / a b i m n o )
(repeat (setq i (sslength s))
        (if
                (and
                        (setq o (vlax-ename->vla-object (ssname s (setq i (1- i)))))
                        (vlax-method-applicable-p o 'getboundingbox)
                        (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list o 'a 'b))))
                )
                (setq m (cons (vlax-safearray->list a) m)
                        n (cons (vlax-safearray->list b) n)
                )
        )
)
(if (and m n)
        (mapcar '(lambda ( a b ) (apply 'mapcar (cons a b))) '(min max) (list m n))
)
)





编辑：
做了一些实验来解决一些小问题，我再次更改了这一部分：
                        ( (while (not (setq ent (entsel "\nPick a line or a polyline's segment"))) ent )
                )
用cond的每个语句进行这样的实验非常方便，而不会让代码立即失败！

David Bethel 发表于 2022-7-5 18:05:00

我更喜欢测试

(and (do step 1)
    (do step 2)
    (do step 3)
)

 
如果任何步骤未能返回非零值，则此操作将停止。我不喜欢在其他测试中创建包含的拾取集
 

(while (not ss)
         (setq ss (ssget)))

 
如果您没有选择任何内容，为什么要运行该程序？否则你必须重新开始例行程序。我的0.02美元
 
-大卫

Grrr 发表于 2022-7-5 18:08:40

我同意，大卫
 
我只是想尝试一下，看看这种编写代码的方式有什么不同。。。
所以你说的是这样的：
(if
(and ; Evaluate arguments from user within the "and" function
        (if
                (not (Stuff to do #1 ))
                (princ "\nTheres something wrong in #1 try again!")
                (Stuff to do #1 )
        )
        (if
                (not (Stuff to do #2 ))
                (princ "\nTheres something wrong in #2 try again!")
                (Stuff to do #2 )
        )
        (if
                (not (Stuff to do #3 ))
                (princ "\nTheres something wrong in #3 try again!")
                (Stuff to do #3 )
        )
); All arguments are evaluated, the code proceeds
(while somethingisdone ; example: a selection was made and the same must be copied or moved within the while loop
        (progn
                (while
                        (not (setq pickline (entsel "\nPick a line")))
                        pickline
                        (cond
                                (   (= 7 (getvar 'errno))
                                        (princ "\nYou must select a line.")
                                )
                                (   (null pickline)
                                        (princ "\nYou missed, try again.")
                                )
                        )
                ); to exit this loop and continue a line must be picked
                (We got everything we need from Stuff #1, #2 and #3, now the code does its job... )
        ); the code did its job, exiting with my favourite ESC key, and don't forget the error handling if needed!
)
);if                                       
我做了一个有点复杂的例子，我不确定and函数中的那些“断点”是否会起作用。
 
无论如何，我正在努力向论坛中最好的人学习——每次我觉得我在做80%的代码，剩下的20%我必须得到你们的帮助，因为无论我多么努力，我似乎都不可能找到错误。

David Bethel 发表于 2022-7-5 18:10:50

这更多的是个人喜好。
 
我的碰巧是：
 
[列表]
[*]（initget）->（get）所有用户输入
[*]（ssget）带过滤器
[*]做你正在做的事情
[/列表]
 
至于错误检查和报告，发生的绝大多数错误
在开发过程中，要么破坏整个例程，要么做一些非常重要的事情
显然，这是不可能错过的。
 
对我来说，另一个优先事项是可读性。我有几十年的习惯。如果有必要的话
有一天编辑它们，它的格式我可以快速阅读和破译。
 
（and）测试允许您同时进行多个测试。
 
例如，ie：
 
编辑仅为c色的第nnn\u个数字属性
 

(defun c:ean (/ n et ns ss i en an ad x et nv c)

(initget 7)
(setq n (getint "\nATTRIBute Number To Edit:"))

(while (or (not c)
            (> c 255))
      (initget 4)
      (setq c (getint "\nATTRIBute Color Number:   ")))

(initget 1 "Replace Prefix Suffix")
(setq et (getkword "\nEdit Type - Replace Prefix Suffix:   "))
(cond ((= et "Replace")
      (setq ns (getstring t (strcat "\nString To Add As ATTRIBute " (itoa n) ":   "))))
       ((= et "Prefix")
      (setq ns (getstring t (strcat "\nPrefix To Add As ATTRIBute " (itoa n) ":   "))))
       ((= et "Suffix")
      (setq ns (getstring t (strcat "\nPrefix To Add As ATTRIBute " (itoa n) ":   ")))))

(while (not ss)
      (setq ss (ssget (list (cons 0 "INSERT")
                              (cons 66 1)))))

(setq i 0)
(while (setq en (ssname ss i))
      (setq an (entnext en)
            ad (entget an)
               x 1)
      (while (= "ATTRIB" (cdr (assoc 0 ad)))
               (and (= x n)
                  (= c (cdr (assoc 62 ad)))
                  (setq nv (cond ((= et "Replace") ns)
                                 ((= et "Prefix")(strcat ns (cdr (assoc 1 ad))))
                                 ((= et "Suffix")(strcat (cdr (assoc 1 ad)) ns))))
                  (setq ad (subst (cons 1 nv) (assoc 1 ad) ad))
                  (entmod ad))
                (setq x (1+ x)
                     an (entnext an)
                     ad (entget an)))
      (entupd en)
      (setq i (1+ i)))

(prin1))

 
没有“正确”的方法，只有有效或无效的方法。这就是
正确配置以处理AutoCAD环境（本地化变量，
重置系统变量）
 
HTH-David
 
-大卫

Grrr 发表于 2022-7-5 18:16:24

是的，我知道。但有时，如果错误不那么明显，则需要切换这些断点。
除非您是VLIDE用户，并且具有其调试功能的优势。
 
大卫，
我一直想知道如何实现这样的语法颜色可读性。
我已经搜索过了，但我在任何地方都找不到如何通过在语法上应用颜色来增加语法，就像在你的示例中一样。

David Bethel 发表于 2022-7-5 18:19:34

我不使用vlide接口（它直到2000年才出现）
 
在旧版本中，如果*error*设置为零并且遇到错误，则整个例程将被回调
 

(defun c:test ()
(setq *error* nil)
(setq a
   (setq b
   (setq c
       (setq d (/ 1.0 0)))))
)

 
返回
 

Command: test
error: divide by zero
(/ 1.0 0)
(SETQ D (/ 1.0 0))
(SETQ C (SETQ D (/ 1.0 0)))
(SETQ B (SETQ C (SETQ D (/ 1.0 0))))
(SETQ A (SETQ B (SETQ C (SETQ D (/ 1.0 0)))))
(C:TEST)
*Cancel*

 
vs 2000及以后：
Command: test
; error: divide by zero

 
这就是我从不接受新版本的主要原因之一。
 
至于着色，大多数原始autolisp括号检查器都是颜色匹配程序。他们是独立的。exe文件。
 
当Autodesk放弃Compuserve作为其官方论坛并开始自己的基于互联网的论坛时，它只使用html格式。一些独立团体也是如此。
 
我只是做了一个lisp例程，转换了。lsp文件。htm文件并添加了颜色匹配。使用CADtutor，在消息正文中使用bbc编码。所以我简单地将例程更改为以bbc代码格式输出。
 
http://www.bbcode.org/reference.php
 
我主要在这里使用它，因为我觉得它是一个更好的教学工具。我确实使用Ally 3.0程序进行生产工作，在开发例程时进行错误检查和分析。
 
-大卫

查看完整版本: 找不到线的中点