[LISP程序]：一个简单拷贝数字递增程序可用于平面标高复制

eachy · 发表于 2005-1-16 13:06:10

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

写的非常简单，可用于理正标高的复制

(vl-load-com)
(if (not $ea_copy_bj)
(setq $ea_copy_bj 0.0)
)
(defun c:tt (/ ss ssl tf tf0 str jd p p1 e el _copy_bj s1)
(if (setq ss (ssget))
(progn
(if (setq s1 (ssget "p" '((0 . "text"))))
(progn
(setq ssl (sslength s1)
tf t
)
(while (and tf (> ssl 0))
(setq e (ssname s1 (setq ssl (1- ssl))))
(if (and (= (cdr (assoc 0 (setq el (entget e)))) "TEXT")
(setq
tf0 (or (distof (setq str (cdr (assoc 1 el))))
(and
(wcmatch (strcase str) "%%P*")
(distof (vl-string-left-trim "%Pp" str))
)
)
)
)
(setq tf nil)
)
)
(if tf0
(progn
(if (vl-string-search "." str)
(setq
jd (1- (- (strlen str) (vl-string-search "." str)))
)
)
(setq _copy_bj
(getdist (strcat "\n增量<"
(vl-princ-to-string $ea_copy_bj)
">: "
)
)
)
(if _copy_bj
(setq $ea_copy_bj _copy_bj)
)
;;(setvar "osmode" 0)
(if (setq p (getpoint "\n基点: "))
(while (setq p1 (getpoint p "\n目标点: "))
(vl-cmdf ".copy" ss "" "0,0,0" "@")
(vl-cmdf ".move" ss "" p p1)
(vla-put-textstring
(vlax-ename->vla-object e)
(if jd
(setq str (rtos (+ (atof str) $ea_copy_bj) 2 jd))
(setq str (vl-princ-to-string
(+ (atof str) $ea_copy_bj)
)
)
)
)
(setq p p1)
)
)
)
)
)
)
)
)
(princ)
)

(vl-load-com) 
(if (not $ea_copy_bj) 
  (setq $ea_copy_bj 0.0) 
) 
(defun c:tt (/ ss ssl tf tf0 str jd p p1 e el _copy_bj s1) 
  (if (setq ss (ssget)) 
    (progn 
      (if (setq s1 (ssget "p" '((0 . "text")))) 
        (progn 
          (setq        ssl (sslength s1) 
                tf  t 
          ) 
          (while (and tf (> ssl 0)) 
            (setq e (ssname s1 (setq ssl (1- ssl)))) 
            (if        (and (= (cdr (assoc 0 (setq el (entget e)))) "TEXT") 
                     (setq 
                       tf0 (or (distof (setq str (cdr (assoc 1 el)))) 
                               (and 
                                 (wcmatch (strcase str) "%%P*") 
                                 (distof (vl-string-left-trim "%Pp" str)) 
                               ) 
                           ) 
                     ) 
 
                ) 
              (setq tf nil) 
            ) 
          ) 
          (if tf0 
            (progn 
              (if (vl-string-search "." str) 
                (setq 
                  jd (1- (- (strlen str) (vl-string-search "." str))) 
                ) 
              ) 
              (setq _copy_bj 
                     (getdist (strcat "\n增量<" 
                                      (vl-princ-to-string $ea_copy_bj) 
                                      ">: " 
                              ) 
                     ) 
              ) 
              (if _copy_bj 
                (setq $ea_copy_bj _copy_bj) 
              ) 
              ;;(setvar "osmode" 0) 
              (if (setq p (getpoint "\n基点: ")) 
                (while (setq p1 (getpoint p "\n目标点: ")) 
                  (vl-cmdf ".copy" ss "" "0,0,0" "@") 
                  (vl-cmdf ".move" ss "" p p1) 
                  (vla-put-textstring 
                    (vlax-ename->vla-object e) 
                    (if        jd 
                      (setq str (rtos (+ (atof str) $ea_copy_bj) 2 jd)) 
                      (setq str        (vl-princ-to-string 
                                  (+ (atof str) $ea_copy_bj) 
                                ) 
                      ) 
                    ) 
                  ) 
                  (setq p p1) 
                ) 
              ) 
            ) 
          ) 
        ) 
      ) 
    ) 
  ) 
  (princ) 
)

村长 · 发表于 2005-1-16 15:09:53

谢谢EA,运行以后递增值没问啊,提示如下
命令: tt
选择对象: 找到 5 个，1 个编组
选择对象:
命令:

那里出了问题?

eachy · 发表于 2005-1-16 17:59:38

选择集有数字吗？

xmchy · 发表于 2005-1-16 19:15:55

问题大大的，首先r14下不能用，其次标注出的单位是毫米，建议改为米，－立面、剖面标高单位，不能随便设0。000的点。谢谢！　

xiaochongcn · 发表于 2005-1-16 19:53:21

斑竹，改改啊。
应该很好用。
另外捕捉屏蔽了不太好。。

村长 · 发表于 2005-1-16 19:56:05

最初由 eachy 发布
[B]选择集有数字吗？ [/B]

发现问题出在哪里了.数字是有的,但是只要第一个选择的如果是0.000就出错了.请测试!还有捕捉屏蔽建议取消.在改进下就非常棒了!

建议Qun在编排序号这个功能里也增加这个功能,命令名字建议改进为递增复制,这样才名副其实.现在的编排序号有递增复制的功能很让人费解.所以知道者甚少.

eachy · 发表于 2005-1-16 20:18:29

知道了，你选择的是 %%P0.000，1楼程序已经更新。

声明，本人不用理正也不用 R14，写这个程序纯粹算是应人之约。

村长 · 发表于 2005-1-16 20:58:13

OK了,谢谢EA!

huyong · 发表于 2005-1-16 21:35:32

谢谢斑竹！但应考虑增量值与标注点间的实际值相等才好呀。
还有R14下不能使用。

eachy · 发表于 2005-1-16 21:49:41

最初由 huyong 发布
[B]谢谢斑竹！但应考虑增量值与标注点间的实际值相等才好呀。
还有R14下不能使用。 [/B]

你说的情况用另外的工具，论坛上有“动态标高”

村长 · 发表于 2005-1-17 11:54:43

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

最初由 huyong 发布
[B]谢谢斑竹！但应考虑增量值与标注点间的实际值相等才好呀。
还有R14下不能使用。 [/B]

EA斑竹已经解释了，不会考虑R14。想要就等理正加这个功能吧。

my_autocad · 发表于 2006-8-21 10:06:54

老大,我试用了哈,如果是字母加数字的话,就不行哈!除非把字母与数字分开!
可以不可以,先复制数字+文字成列或行时,再递增呢?

andyhua5240 · 发表于 2006-8-21 12:03:24

理正现在的注标高支持这个功能呀！

村长 · 发表于 2006-8-22 00:48:03

晕,这个贴子都快2年了,早过时了还被翻上来,现在理正的标高表太好用了~

zhf7799886 · 发表于 2006-8-27 16:40:29

应该很好用。
另外捕捉屏蔽了不太好.

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

[LISP程序]：一个简单拷贝数字递增程序可用于平面标高复制

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子