请各位帮忙调整下代码

wangxf888

wyl219

  (setq lst (x_ssn ss))修改为
  (setq lst (reverse (x_ssn ss)))

wyl219

当然,最好的方式是应该是根据线段的位置重新排序,这样改动比较大.

wyl219

由于选择集的排序是根据选择顺序排序的,即如果不是直接框选的,会根据选择顺序排序,原代码例如有三条多段线,上下排列,框选时选择集是按照从下到上排序的,用reverse处理后就变成了从上到下排序.
但如果是先点选的第二条线,之后框选剩下两根,则不能安装线段位置排序.
修改后根据多段线起点位置排序(即第一个组码10),并增加字高设定,如果不需要,可以将
        (setq h (getreal "\n字高,空格取默认值250:"))
        (if (not h) (setq h 250))
删除,并将(emk_t "0" pt pt tl 0 1 0 h))中的h改为0.

(defun c:y1(/
                                                 ss  qz  lst length_lst         en         pt_lst         curve-obj
                                                 dist         s_lst n pt tl h
                                                 emk_t HH:ssPts:Sort
                                         )

  (defun emk_t (layer pt1 pt2 text ang n72 n73 h /)
    (entmake (list '(0 . "text")
                                                         '(100 . "AcDbEntity")
                                                         (cons 8 layer)
                                                         '(100 . "AcDbText")
                                                         (cons 10 pt1)
                                                         (cons 1 text)
                                                         (cons 40 h)
                                                         '(41 . 0.75)
                                                         '(7 . "standard")
                                                         (cons 72 n72)
                                                         (cons 11 pt2)
                                                         (cons 50 ang)
                                                         (cons 73 n73)
             ) ;_ 结束list
    ) ;_ 结束entmake
  ) ;_ 结束defun
        ;|
        ;;ssPts: 1 选择集，返回图元列表
        ;;           2 点表(1到n维 1维时key只能是x或X)，返回点表
        ;;          3 图元列表，返回图元列表
        ;;Key: "xyzXYZ"任意组合,例如"yX",y在前表示y坐标优先，小y表示从小到大(注:二维点时，不能有z)
        ;;FUZZ: 允许误差
        ;;注:点表可以1到n维混合,Key长度不大于点的最小维数。
        ;;示例1 (HH:ssPts:Sort (ssget) "YxZ" 0.5);返回(<Entity name: 7ef7b3a8> <Entity name: 7ef7b3a0>)
        ;;示例2 (HH:ssPts:Sort (list '(2 3) '(3 5)) "Yx" 0.5);返回((3 5) (2 3))
        ;;示例3 (HH:ssPts:Sort '(<Entity name: 7ef79a28> <Entity name: 7ef79a10>) "YxZ" 0.5)
        ;;示例4 (HH:ssPts:Sort (list "DF" "ZX" "A" "DD" "A") "X" 1)=>("ZX" "DF" "DD" "A" "A")
        ;;示例5 (HH:ssPts:Sort (list 5 8 5 9) "X" 1)=>(9 8 5)
        ;;本程序是在fsxm的扩展 自贡黄明儒 2014年3月22日
        1 3
        2 4
        XY3412
        xy2143
        xY1234
        Xy4321
        yx2413
        Yx1324
        yX4231
        YX3142
        如果传入的是点对列表会出错
        修改后,key可以是代表二维点排序的int,排序见上面列表
        |;
        (defun HH:ssPts:Sort (ssPts KEY FUZZ / E EN FUN LST N sortpts sortpts1 )
                ;(defun HH:ssPts:Sort (ssPts KEY FUZZ / )
                ;;1 点列表排序
                (defun sortpts (PTS FUN xyz FUZZ)
                        (vl-sort pts
                                '(lambda (a b)
                                         (if (not (equal (xyz a) (xyz b) fuzz))
                                                 (fun (xyz a) (xyz b))
                                         )
                                 )
                        )
                )
                ;;2 排序
                (defun sortpts1 (PTS KEY FUZZ)
                        (setq Key (vl-string->list Key))
                        (foreach xyz (reverse Key)
                                (cond ((< xyz 100)
                                                                (setq fun >)
                                                                (setq xyz (nth (- xyz 88) (list car cadr caddr)))
                                                        )
                                        (T
                                                (setq fun <)
                                                (setq xyz (nth (- xyz 120) (list car cadr caddr)))
                                        )
                                )
                                (setq Pts (sortpts Pts fun xyz fuzz))
                        )
                )
                ;;增加的部分,这样传入的就可以是代表顺序的数字了,不过只能用于二维点
                (if (= 'INT (type key));如果key是实数才进行下面的判断
                        (cond
                                ((= 12 key ) (setq key "xY"))
                                ((= 21 key) (setq key "xy"))
                                ((= 34 key) (setq key "XY"))
                                ((= 43 key) (setq key "Xy"))
                                ((= 13 key ) (setq key "Yx"))
                                ((= 31 key) (setq key "YX"))
                                ((= 24 key) (setq key "yx"))
                                ((= 42 key) (setq key "yX"))
                                (t)
                        );end cond
                )
                ;
                ;;3 本程序主程序
                (cond
                        ((= (type ssPts) 'PICKSET)
                                (repeat (setq n (sslength ssPts))
                                        (if (and        (setq e (ssname ssPts (setq n (1- n))))
                                                                (setq en (entget e))
                                                        )
                                                (setq lst (cons (append (cdr (assoc 10 en)) (list e)) lst))
                                        )
                                )
                                (mapcar 'last (sortpts1 lst KEY FUZZ))
                        )
                        ((Listp ssPts)
                                (cond
                                        ((vl-consp (car ssPts))
                                                (sortpts1 ssPts KEY FUZZ))
                                        ((= (type (car ssPts)) 'ENAME)
                                                (foreach e ssPts
                                                        (if (setq en (entget e))
                                                                (setq lst (cons (append (cdr (assoc 10 en)) (list e)
                                                                                                                                ) lst))
                                                        )
                                                )
                                                (mapcar 'last (sortpts1 lst KEY FUZZ))
                                        )
                                        (T
                                                (cond ((equal key "X") (vl-sort ssPts '>))
                                                        (T (vl-sort ssPts '<))
                                                )
                                        )
                                )
                        )   
                )
        )
  (SETQ SS (SSGET '((0 . "*LINE,CIRCLE,ARC,ELLIPSE"))))
  (setq qz (getstring "\n前缀:"))
        (setq h (getreal "\n字高,空格取默认值250:"))
        (if (not h) (setq h 250))
        (setq lst  (HH:ssPts:Sort ss 12 0 ))
        ; (setq lst  (x_ssn ss))
  (setq        length_lst
                (mapcar '(lambda (en)
                                                         (vlax-curve-getDistAtParam
                                                                 en
                                                                 (vlax-curve-getEndParam en)
                                                         )
                                                 )
                        lst
                )
  )
        ;(setq en (car lst))
  (setq ;获取多段线的中点,即标注点
    pt_lst (mapcar '(lambda (curve-obj dist)
                      (vlax-curve-getPointAtDist curve-obj (/ dist 2))
                    )
                                                 lst
                                                 length_lst
           )
  )
        ; (setq s_lst nil)
  (repeat (setq n (length length_lst))
    (setq s_lst        (cons (strcat qz
                                                                                                                         (itoa n)
                                                                                                                         "="
                                                                                                                         (rtos (nth (1- n) length_lst) 2 2)
                                                                                                                 )
                                                                                                 s_lst
                                                                                         )
    )
    (setq n (1- n))
  )
  (mapcar '(lambda (pt tl) (emk_t "0" pt pt tl 0 1 0 h))  ;此句可以将(emk_t "0" pt pt tl 0 1 0 250))做变量(250改文字大小)
                pt_lst
                s_lst
  )
)

wangxf888

wyl219 发表于 2019-11-24 02:06
由于选择集的排序是根据选择顺序排序的,即如果不是直接框选的,会根据选择顺序排序,原代码例如有三条多段线, ...

非常感谢兄弟昨天的回复，今天白天有点事，现在才看到 不好意思！ 现在有点小问题还需帮忙指点一下，我在截图上标注了下 我想要的就是图2的标注顺序，但是不能全部用reverse这个命令，因为有的点表本来就是逆时针的，reverse后标注顺序又成了顺时针方向，是要加判断还是要改动什么地方呢，恳请指点，先谢了！！

wyl219

这种不规则的图形很难确定顺时针还是逆时针的,容易出现不易发现的错误.
如果所有线都是首尾相连的还是比较简单的,先选择一条线,然后找到跟他首尾相连的另外两条线,由用户选择其中一条线,之后根据顶点重合的原则依次往下排就好了.

wangxf888

看来没答案了  结贴！