关于文字编辑的lisp

lijiao

(defun c:blkcl (/ NUM OUT P1 P2 PT PTS PTSN SS TEXT TEXT2 X Y Z)
  (vl-load-com)
  (if (setq ss (ssget '((0 . "INSERT"))))
    (progn
      (setq out (ss->vla-list ss))
      (setq out        (mapcar        '(lambda (x)
                           (vla-GetBoundingBox x 'p1 'p2)
                           (list (vlax-safearray->list p1)
                                 (vlax-safearray->list p2)
                           )
                         )
                        out
                )
      )
      (setq ss (mapcar '(lambda        (x)
                          (ssget "c" (car x) (cadr x) '((0 . "text")))
                        )
                       out
               )
      )
      (setq ss (mapcar 'ss->vla-list ss))
      (foreach item ss
        (setq item (mapcar '(lambda (x)
                              (vla-GetBoundingBox x 'p1 'p2)
                              (setq pts        (list (vlax-safearray->list p1)
                                              (vlax-safearray->list p2)
                                        )
                              )
                              (setq pts        (mapcar        '(lambda (y z)
                                                   (* 0.5 (+ y z))
                                                 )
                                                (car pts)
                                                (cadr pts)
                                        )
                              )
                              (list x pts)
                            )
                           item
                   )
        )
        (setq item (vl-sort item
                            '(lambda (x y)
                               (< (cadr (cadr x)) (cadr (cadr y)))
                             )
                   )
        )
        (setq text (mapcar '(lambda (x)
                              (vla-get-textstring (car x))
                            )
                           item
                   )
        )
        (setq text (mapcar 'vl-string->list text))
        (setq text (mapcar '(lambda (x)
                              (vl-remove 32 x)
                            )
                           text
                   )
        )
        (setq text2 (cadr text))
        (setq text2 (mapcar '(lambda (x)
                               (if (and        (>= x 48)
                                        (<= x 57)
                                   )
                                 (list t x)
                                 (list nil x)
                               )
                             )
                            text2
                    )
        )
        (setq num (mapcar '(lambda (x)
                             (if (= t (car x))
                               (cadr x)
                             )
                           )
                          text2
                  )
        )
        (setq num (vl-remove nil num))

        (setq text2 (mapcar '(lambda (x)
                               (if (= nil (car x))
                                 (cadr x)
                               )
                             )
                            text2
                    )
        )
        (setq text2 (vl-remove nil text2))
        (setq text (list (append num (car text)) text2))
        (setq text (mapcar 'vl-list->string text))
        (mapcar        '(lambda (x y)
                   (vla-put-textstring (car x) y)
                 )
                item
                text
        )
        (setq pts (mapcar 'cadr item))
        (setq item (mapcar 'car item))
        (setq ptsn (mapcar '(lambda (x)
                              (vla-GetBoundingBox x 'p1 'p2)
                              (setq pt (list (vlax-safearray->list p1)
                                             (vlax-safearray->list p2)
                                       )
                              )
                              (mapcar '(lambda (y z)
                                         (* 0.5 (+ y z))
                                       )
                                      (car pt)
                                      (cadr pt)
                              )
                            )
                           item
                   )
        )
        (mapcar        '(lambda (x y z)
                   (vla-move x (vlax-3d-point y) (vlax-3d-point z))
                 )
                item
                ptsn
                pts
        )
      )
    )
  )
  (princ)
)
(defun ss->vla-list (ss / I OUT)
  (setq        i   -1
        out '()
  )
  (repeat (sslength ss)
    (setq out (cons (ssname ss (setq i (1+ i))) out))
  )
  (setq out (mapcar 'vlax-ename->vla-object out))
)

cindy_fisher

lijiao 发表于 2011-9-28 10:49
(defun c:blkcl (/ NUM OUT P1 P2 PT PTS PTSN SS TEXT TEXT2 X Y Z)
  (vl-load-com)
  (if (setq ss (s ...

我想让程序实现自动搜索块名字，然后进行文字编辑，就改成了下面的语句：
(setq ss (ssget  "X" '((0 . "INSERT") (2 . "DCS_FUNC_ACCESS_IN_PRIME_LOC")))))

结果就出现了语法错误，请指教，谢谢

lijiao

如果是这句出现了问题，可能是多了一个括号。

cindy_fisher

lijiao 发表于 2011-9-29 11:46
如果是这句出现了问题，可能是多了一个括号。

去掉一个括号，成功了，谢谢，但是去掉后右括号和左括号的个数是不对应的，很奇怪。

我的图上不只这个块要执行，其他还有三个块（DDCS_B, DDCS_C,DDCS_D）也要执行，ssget后面两个括号表示“并”的意思，有没有什么方法表示或者的意思。
谢谢。

英雄无敌

或者的话用块名用逗号分开就可以了，如(2 . "b1,b2,b3"))))

cindy_fisher

英雄无敌 发表于 2011-10-8 16:17
或者的话用块名用逗号分开就可以了，如(2 . "b1,b2,b3"))))

谢谢，解决了我的大问题，我还想着用好几个cond ,然后执行修改动作的那个sub