偏爱云~小吴 发表于 2013-11-30 16:37:42

已有 5 人购买  本主题需向作者支付 1 个明经币 才能浏览 购买主题

xyp1964 发表于 2013-11-30 16:44:59


xyp1964 发表于 2013-11-30 17:40:53

;; 需要e派工具箱(XCAD)的支持：http://yunpan.cn/QXQKsW9gAPmpF(defun c:tt ()
(xyp-CMDLA0)
(setq        int (Uint 7 "" "等分数量" int)
        i   -1
)
(xyp-MkLaCo "DIM" 3)
(princ "\n选择圆弧: ")
(if (setq ss (ssget '((0 . "ARC"))))
    (while (setq s1 (ssname ss (setq i (1+ i))))
      (xyp-Group0)
      (setq pc       (xyp-DXF 10 s1)
          ptn       (xyp-get-CurveDivNumPtlst s1 int)
          ptn1 (reverse (cdr (reverse ptn)))
          ptn2 (cdr ptn)
      )
      (mapcar '(lambda (x y) (xyp-Dim-ArcP s1 x y)) ptn1 ptn2)
      (xyp-Group1)
    )
)
(xyp-CMDLA1)
)

偏爱云~小吴 发表于 2013-12-3 13:05:31

(defun c:zm1 (/ mycopy mymove SstoEs sign ss p1 p2 indx)
(vl-load-com)
(defun SstoEs(ss / a en lst)
    (if ss(progn(setq a -1)(while(setq en(ssname ss(setq a(1+ a))))(setq lst (cons en lst)))))
    lst)
;(defun sign (nn) (if (< nn 0) 1 (if (> nn 0) -1 0)))
(defun mycopy(ss p p1 / ty q q1 s1 s2);;参照by-xyp1964的xyp-ScaleEntity
    (setq ty(type ss)i -1s2(ssadd)q1(vlax-3D-point(trans p1 0 0))q(vlax-3D-point(trans p 0 0)))
    (cond((= ty 'ENAME)(vla-move(vla-copy(vlax-ename->vla-object ss))q q1)(setq s2(ssadd(entlast)s2)))
         ((= ty 'PICKSET)(setq i -1)(while (setq s1 (ssname ss (setq i (1+ i))))
                                        (mycopy s1 p p1)(setq s2(ssadd(entlast)s2))))
         ((= ty 'LIST)(foreach x ss(mycopy x p p1)(setq s2(ssadd(entlast)s2))))
         )s2)
(defun mymove(ss p p1 / ty q q1 s1);;参照by-xyp1964的xyp-ScaleEntity
    (setq ty(type ss)i -1
          q1(vlax-3D-point(trans p1 0 0)) q(vlax-3D-point(trans p 0 0)))
    (cond((= ty 'ENAME)(vla-move(vlax-ename->vla-object ss)q q1))
         ((= ty 'PICKSET)(setq i -1)
          (while (setq s1 (ssname ss (setq i (1+ i))))
            (mymove s1 p p1)))
         ((= ty 'LIST)(foreach x ss(mymove x p p1))))
    )
(if ind (princ) (setq ind 1))
(if (setq indx (getint (strcat "\n输入增减量<"(rtos ind 2 0 )"> :"))) (setq ind indx));ind (sign ind))
(prompt"\n选择要进行递增复制的文字、属性:")
(setq ss(SstoEs(ssget'((0 . "*TEXT,ATTDEF")))))
(setq p1(getpoint"\n复制基点:"))
(prompt "\n复制到(右键退出):")
(while(and p1 (setq p2(getpoint p1)) ss)
    (mycopy(setq ss(vl-remove'nil(mapcar'(lambda(x)(setq e(entget x))
                                          (if(assoc 1 e)
                                              (progn(setq tx(vl-string->list (cdr(assoc 1 e))))
;;;                                                (if
;;;                                                (OR (<= (IF(> ind 0)65 66) (last tx) (IF(> ind 0)89 90))
;;;                                                      (<=(IF(> ind 0)97 98)(last tx)(IF(> ind 0)121 122)))x)
                                                ;(princ(+ (last tx) ind))
                                                (if (or(and (>= (+ (last tx) ind) 65)                                                            
                                                            (<= (+ (last tx) ind) 90)                                                            )
                                                       (and (>= (+ (last tx) ind) 97)                                                            
                                                            (<= (+ (last tx) ind) 122)                                                            )
                                                       (and (>= (+ (last tx) ind) 48)                                                            
                                                            (<= (+ (last tx) ind) 57)                                                            
                                                            )) x)
                                                )))ss)))p1 p1)
    (mymove ss p1 p2)
    (mapcar'(lambda(x)(entmod(setq e(entget x)tx(vl-string->list (cdr(assoc 1 e)))
                                 e(subst(cons 1 (vl-list->string(reverse(cons
                                                                            ;((IF(> ind 0)1+ 1-)(last tx))
                                                                           (+ (last tx) ind)
                                                                            (cdr(reverse tx))))))(assoc 1 e)e)))
            nil)ss)
    (setq p1 p2)
    (if ss (princ)(princ "\n超出范围或末尾不是字母,程序退出!'"))
    )
(princ)
)

duanshui83 发表于 2013-12-4 13:17:00

看一下都要交钱！！
建议看一下这个：圆弧等分标注【源码】
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=99511&fromuid=420842

香田里浪人 发表于 2013-12-4 18:38:18

看一下都要交钱！！

bikeboy 发表于 2013-12-4 18:44:33

看一下就要钱有点不厚道啊

jierc 发表于 2024-11-1 14:50:44

duanshui83 发表于 2013-12-4 13:17
看一下都要交钱！！
建议看一下这个：圆弧等分标注【源码】
http://bbs.mjtd.com/forum.php?mod=viewthre ...

楼主就是这个，用别人的源码收费....

阿猪蛋 发表于 2024-11-4 09:09:35

看一下都要交钱！！
页: [1]
查看完整版本: 圆弧等分标注