自动编号问题

love1030312 发表于 2014-6-10 16:07:44

各位大神门这是个编号程序论坛上有很多但都不能在执行命令的时候让选择输入字的大小都是默认程序里边的大小请大神门帮忙完善下谢谢啊

672505821 发表于 2022-1-30 19:08:59

zmzk 发表于 2022-1-29 17:56
加入这些封闭图形大小不一样，排序还是会出现问题的

这就需要用到排序了，这个只是对图元出现的顺序进行排序

296715530 发表于 2019-12-12 15:45:25

edata 发表于 2016-8-4 21:49
这个就是上面的代码文件，选择对象，根据对象顺序填写序号。命令 tt

数字位置能改吗

zmzk 发表于 2022-1-29 17:56:28

加入这些封闭图形大小不一样，排序还是会出现问题的

edata 发表于 2014-6-10 16:42:50

本帖最后由 edata 于 2014-6-10 17:07 编辑

顺序已改
(defun c:tt(/ ss font_height1 n k po na)
(or font_height (setq font_height 100))
   (if(setq font_height1(getdist (strcat "\n输入文字高度<"(rtos font_height 2 )">:")))
   (setq font_height font_height1))
(if(and (setq ss (ssget (list '(0 . "LWPOLYLINE"))))
      )
(progn
(setq n 0 k 1)
(repeat (sslength ss)
(setq na (ssname ss n))
(setq po (Get_center_relative na))
(entmake (list '(0 . "MTEXT")
               '(100 . "AcDbEntity")
               '(100 . "AcDbMText")
               (cons 7(getvar 'TEXTSTYLE))
               (cons 1 (rtos k 2 0))
               (cons 10 po)
               (cons 40 font_height)
               (cons 71 5)
               )
         )
;(command "text" "j" "mc" "non" po font_height 0 k "")
(setq k (1+ k))
(setq n (1+ n))
)
)
)
(princ)
)

(defun Get_center_relative (ename /Pts 2R Mk Mklinepoints DelLine Tssred
               i lstNNewlst DistList R NumberTssbak TssSubPt)
(setq Obj (Vlax-Ename->Vla-Object ename)
      Tssbak(Vlax-Get Obj 'Thickness )
      TssSub(Vlax-Put Obj 'Thickness 0 ))
(setq Pts (GetBoundingBox ename)
      2R    (MJ:MIDPOINT (CAR Pts) (CADR Pts))
      Mk    (entmake (list (cons 0 "LINE")(cons 8 "JMDSS")(cons 10 (polar 2R 0.0 1000))(cons 11 (polar 2R 3.14159 1000))))
      Mkline(entlast)
      points(vlax-invoke (vlax-ename->vla-object ename) 'IntersectWith (vlax-ename->vla-object Mkline) acExtendOtherEntity)
      Tssred(Vlax-Put Obj 'Thickness (eval Tssbak) )
      DelLine (entdel Mkline)
      i    0
      lst nil
      )
(repeat (/ (length points) 3)
   (setq lst (append lst (list (list (nth i points) (nth (1+ i) points) (nth (+ 2 i) points)))))
   (setq i (+ i 3))
)
(setq lst (px lst))
(if (>= (length lst) 4)
   (progn
      (setq N    0
            Newlst nil)
      (repeat (/ (length lst) 2)
         (setq Newlst (append Newlst (list (list (nth N lst) (nth (1+ N) lst)))))
         (setq N (+ 2 N))
      )
      (setq DistList nil
            R    0)
      (repeat (length Newlst)
         (setq Number (nth R Newlst)
               DistList (append DistList(list(distance (car Number) (cadr Number)))))
         (setq R (1+ R))
      )
      (setqPt (nth (vl-position (car (vl-sort DistList '>)) DistList) Newlst))
   (MJ:MIDPOINT (car pt) (cadr pt));返回值
   )
   (MJ:MIDPOINT (car lst) (cadr lst));返回值
)
)

(defun MJ:MIDPOINT (P1 P2)
(mapcar '(lambda (X Y) (/ (+ X Y) 2.0)) P1 P2)
)

(defun GetBoundingBox (ent / ll ur)
(vla-getboundingbox (vlax-ename->vla-object ent) 'll 'ur)
(mapcar 'vlax-safearray->list (list ll ur))
)

(defun px (X)
(vl-sortX
         (function (lambda (e1 e2)
                     (< (car e1) (car e2)) ) ) )
)

love1030312 发表于 2014-6-10 17:05:32

edata 发表于 2014-6-10 16:42 static/image/common/back.gif

大哥谢谢啊就是这样的但是能帮我改下顺序吗？你这个是反的能改正码？（你的开始数字和结束数字反过来下）谢谢

cuyong123 发表于 2014-6-10 21:08:49

喜欢！呵呵

edata 发表于 2014-6-11 09:56:15

love1030312 发表于 2014-6-10 17:05 static/image/common/back.gif
大哥谢谢啊就是这样的但是能帮我改下顺序吗？你这个是反的能改正码？（你的开始数字和结束 ...

数值是按照选择顺序排序的，如果是框选按图形建立逆向顺序排序。
关于这个排序，水很深，暂时不涉及。

翔飞125 发表于 2015-2-28 14:23:28

edata 发表于 2014-6-11 09:56 static/image/common/back.gif
数值是按照选择顺序排序的，如果是框选按图形建立逆向顺序排序。
关于这个排序，水很深，暂时不涉及。

若再能解决排序问题的话就更完美了

zzust 发表于 2016-6-20 14:28:57

谢谢，学习的参考

906460210 发表于 2016-8-4 16:25:06

没看明白，，，，，，，

906460210 发表于 2016-8-4 16:26:42

求一个自动编号闭合面的插件

edata 发表于 2016-8-4 21:49:22

906460210 发表于 2016-8-4 16:26 static/image/common/back.gif
求一个自动编号闭合面的插件

这个就是上面的代码文件，选择对象，根据对象顺序填写序号。命令 tt

页: [1] 2

明经CAD社区's Archiver

自动编号问题