[求助]哪位高手帮忙看看这个程序错在了哪里？

userzhl · 发表于 2009-5-25 08:07:00

而且，此程序如果标高值是“%%P0.000”的话，会选不中的，不知什么原因。

userzhl · 发表于 2009-5-25 11:11:00

;; ▓ (ltax:ss->axss ss)
;; [功能] 将 ALISP 选择集转换为 VLA 选择集
;; [参数] ss---选择集
(defun ltax:ss->axss (ss / ssp axss)
(setq ssp (ssget "_p"))
(sssetfirst nil ss)
(ssget "_I")
(setq axss (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object))))
(if (cadr (sssetfirst nil ssp)) (ssget "_I"))
(sssetfirst)
axss
)

(Defun c:tt ( / blk bnn bnx data ii scl sn ss ssi str)
(princ "\n 请选择图块 <退出>:")
(setq ss (ssget '((0 . "INSERT,TEXT"))))
    (vlax-for BLK (ltax:ss->axss ss)
     (vlax-for X BLK
       (if (and (= (vla-get-objectname X) "AcDbAttributeDefinition")
         (wcmatch (setq str (vla-get-promptstring X))
    "标高*"
         )
    )
(setq data (cons (cons (vla-get-name BLK)
           (read (vl-string-subst
            ""
            "标高_1:"
            str
          )
           )
     )
     data
      )
)
       )
     )
   )
   (foreach blk data
     (setq bnn (car blk)
    bnn (if (= (substr bnn 1 1) "*")
   (strcat "`" bnn)
   bnn
        )
     )
     (if (null bnx)
       (setq bnx bnn)
       (setq bnx (strcat bnx "," bnn))
     )
   )
   (if (and (/= nil bnn) (setq ii -1))
(progn
(vl-cmdf "select" ss "")
(setq ssi (ssget "p" (list (cons 0 "INSERT") (cons 2 bnn))))
     (repeat (sslength ssi)
       (setq sn (ssname ssi (setq ii (1+ ii)))
      scl (cdr (assoc (cdr (assoc 2 (entget sn))) data))
       )
       (command "_.Scale"
         sn
         ""
         (cdr (assoc 10 (entget sn)))
         (/ 50.0 scl)
       )
     )
)
   )
   (princ)
)

这样也不行？

userzhl · 发表于 2009-5-25 17:52:00

我是这么想的：选择一些物体，对这些物体进行过滤，找出符合条件的，获取这些符合条件的“标高_1:”后面的值，最后进行缩放。

mmmmmm · 发表于 2009-5-25 22:39:00

你图里用了大量无名块，所以全部检索肯定是会浪费时间的。
我修改了程序，只检索选到的图块，可能会快一些，但是如果有大量不符合要求的其他图块，速度一样无法真正提高。唯一的办法就只有优化原有的数据或者接受“稍慢”一点的速度。

(Defun c:tt (/ get-scale II OS SCL SN SS *DATA*)
(Defun get-scale (bname / SCALE STR X)
(if (null (setq scale (cdr (assoc bname *data*))))
(vlax-for X
(vla-item
(vla-get-blocks
(vla-get-activedocument (vlax-get-acad-object))
)
bname
)
(if (and (null scale)
(= (vla-get-objectname X) "AcDbAttributeDefinition")
(wcmatch (setq str (vla-get-promptstring X))
"标高_1:*"
)
)
(setq scale (read (vl-string-subst
""
"标高_1:"
str
)
)
*data* (cons (cons bname scale) *data*)
)
)
)
)
scale
)
(setq os (getvar "osmode"))
(if (and (setq ii -1)
(setvar "osmode" 0)
(princ "\n 请选择图块 <退出>:")
(setq ss (ssget (list (cons 0 "insert") (cons 66 1))))
)
(repeat (sslength ss)
(if (and (setq sn (ssname ss (setq ii (1+ ii))))
(setq scl (get-scale (cdr (assoc 2 (entget sn)))))
)
(command "_.Scale"
sn
""
(cdr (assoc 10 (entget sn)))
(/ 50.0 scl)
)
)
)
)
(setvar "osmode" os)
(princ)
)

(Defun c:tt (/ get-scale II OS SCL SN SS *DATA*)
  (Defun get-scale (bname / SCALE STR X)
    (if (null (setq scale (cdr (assoc bname *data*))))
      (vlax-for X
    (vla-item
      (vla-get-blocks
        (vla-get-activedocument (vlax-get-acad-object))
      )
      bname
    )
 (if (and (null scale)
   (= (vla-get-objectname X) "AcDbAttributeDefinition")
   (wcmatch (setq str (vla-get-promptstring X))
     "标高_1:*"
   )
     )
   (setq scale  (read (vl-string-subst
          ""
          "标高_1:"
          str
        )
         )
  *data* (cons (cons bname scale) *data*)
   )
 )
      )
    )
    scale
  )
  (setq os (getvar "osmode"))
  (if (and (setq ii -1)
    (setvar "osmode" 0)
    (princ "\n 请选择图块 <退出>:")
    (setq ss (ssget (list (cons 0 "insert") (cons 66 1))))
      )
    (repeat (sslength ss)
      (if (and (setq sn (ssname ss (setq ii (1+ ii))))
        (setq scl (get-scale (cdr (assoc 2 (entget sn)))))
   )
 (command "_.Scale"
   sn
   ""
   (cdr (assoc 10 (entget sn)))
   (/ 50.0 scl)
 )
      )
    )
  )
  (setvar "osmode" os)
  (princ)
)

我没有具体测试，所以可能会有点小问题。

userzhl · 发表于 2009-5-25 23:39:00

谢谢mmmmmm

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