lisp例程帮助

Corro · 发表于 2022-7-5 17:18:23

大家好

我已经在这个lisp例程上工作了几个星期，每次我完成它，老板都会要求额外的功能。
这次我卡住了。
我附上了lisp文件的副本供您评论。
我现在不知道我改变了什么，原因是什么。
感谢您的帮助。
谢谢
清理-S1a。lsp

Tharwat · 发表于 2022-7-5 17:44:52

你好

您需要在以下代码之前添加cond函数：

((wcmatch ent_name "ROMANS") .....

然后，函数wcmatch的工作方式与程序中显示的if函数不同。

copy


((wcmatch ent_name "ROMANS")
     (setq ans "T")
     (setq ans "F")......

因此，应该考虑最后一个表达式，即变量“ans”在任何情况下都不会等于“t”。

Tharwat · 发表于 2022-7-5 17:52:47

我只是盲目地修改了代码，并没有改变您编写代码的方式，以便您能够在以后需要时修改它，所以只需测试以下mod并让我知道；

copy


(defun c:cleanup  (/ col count ent ent_data ent_lay ent_name hgt1 len new_lay new_tstyle obj_lay ssetmtxt)
 (if (setq ssetmtxt (ssget "_X" '((0 . "*TEXT"))))
   (progn
     (setq len   (sslength ssetmtxt)
           count 0)
     (while (< count len)
       (setq ent      (ssname ssetmtxt count)
             ent_data (entget ent)
             ent_name (cdr (assoc 7 ent_data))
             ent_lay  (cdr (assoc 8 ent_data))
             hgt1     (cdr (assoc 40 ent_data))
             )
       (cond
         ((wcmatch ent_name "ROMANS")
          (setq new_tstyle
                 (cond ((vl-position hgt1 '(1.3 2.6 6.5 13.0 26.0 32.5 65.0 130.0)) "13-TEXT")
                       ((vl-position hgt1 '(1.8 3.6 9.0 18.0 36.0 45.0 90.0 180.0)) "18-TEXT")
                       ((vl-position hgt1 '(2.5 12.5 62.5 250.0)) "25-TEXT")
                       ((vl-position hgt1 '(3.5 7.0 17.5 35.0 70.0 87.5 175.0 350.0)) "35-TEXT")
                       ((vl-position hgt1 '(5.0 10.0 25.0 50.0 100.0 125.0 500.0)) "5-TEXT")
                       (t "7-TEXT")
                       )
                ))
         ((wcmatch ent_name "TXT-#,TXT-##")
          (setq new_tstyle
                 (cons 7
                       (strcat (substr ent_name 5) "-TEXT")))
          (setq obj_lay (strcat "TEXT-" (substr ent_name 5)))
          (setq new_lay
                 (cons 8 (strcat "TEXT-" (substr ent_name 5))))
          (cond
            ((= obj_lay "TEXT-13") (setq col 1))
            ((= obj_lay "TEXT-18") (setq col 7))
            ((= obj_lay "TEXT-25") (setq col 7))
            ((= obj_lay "TEXT-35") (setq col 2))
            ((= obj_lay "TEXT-5") (setq col 5))
            ((= obj_lay "TEXT-7") (setq col 6))
            )
          (or (tblsearch "LAYER" obj_lay)
              (command "-Layer" "m" obj_lay "C" col "" "")
              )
          (vla-put-layer (vlax-ename->vla-object ent) obj_lay)
          )
         )
       (entmod
         (subst (cons 7 new_tstyle) (assoc 7 ent_data) ent_data))
       (setq count (1+ count))
       )
     )
   )
 (princ)
 )
(vl-load-com)

Corro · 发表于 2022-7-5 18:15:48

嗨Tharwat

谢谢你的回复。

我只需要编辑1到2行，现在可以了。

另一个问题，通过下面的cond语句，我试图匹配文本样式和文本高度。

我的问题是，不止一种样式可以具有相同的高度，正如下面的代码所示。

你能提供更好的编程方法吗？

所以我要做的是检查样式是否是罗马语，然后检查文本高度，这将确定要将obj更改为的新样式。

如果没有匹配项，则使用默认样式18-TEXT。

copy

(cond
         ((wcmatch ent_name "ROMANS")
          (setq new_tstyle
                 (cond ((vl-position hgt1 '(1.3 2.6 6.5 13.0 26.0 32.5 65.0 130.0)) "13-TEXT")
                       ((vl-position hgt1 '(1.8 3.6 9.0 18.0 36.0 45.0 90.0 180.0)) "18-TEXT")
                       ((vl-position hgt1 '(2.5 5.0 12.5 25.0 50.0 62.5 125.0 250.0)) "25-TEXT")
                       ((vl-position hgt1 '(3.5 7.0 17.5 35.0 70.0 87.5 175.0 350.0)) "35-TEXT")
                       ((vl-position hgt1 '(5.0 10.0 25.0 50.0 100.0 125.0 500.0)) "5-TEXT")
                       ((vl-position hgt1 '(7.0 14.0 35.0 70.0 140.0 175.0 350.0 700.0)) "7-TEXT")
                       (t "18-TEXT")
                       )
                ))

Tharwat · 发表于 2022-7-5 18:21:58

玩一玩：

copy


(cond
 ((wcmatch ent_name "ROMANS")
  (if (not (vl-some '(lambda (_h _s) (and (vl-position hgt1 _l) (setq new_tstyle _s)))
                    '((1.3 2.6 6.5 13.0 26.0 32.5 65.0 130.0)
                      (1.8 3.6 9.0 18.0 36.0 45.0 90.0 180.0)
                      (2.5 5.0 12.5 25.0 50.0 62.5 125.0 250.0)
                      (3.5 7.0 17.5 35.0 70.0 87.5 175.0 350.0)
                      (5.0 10.0 25.0 50.0 100.0 125.0 500.0)
                      (7.0 14.0 35.0 70.0 140.0 175.0 350.0 700.0)
                      )
                    '("13-TEXT" "18-TEXT" "25-TEXT" "35-TEXT" "5-TEXT" "7-TEXT")))
    (setq new_tstyle "18-TEXT")
    )
  )
 )

[编程交流] lisp例程帮助

发表回复

精选推荐