[求助]圆心座标输出，如何历篇所有座标点让他有序作标记标注

zhongys · 发表于 2009-10-13 18:27:00

以下程式几年前取自明经，忘记是谁的了，好像是龙版主了，作了一点小修改，但程式在作标记是随机的，比较无序，如何历篇所有座标点让他有序作标记标注，如标记从上到下，从左到右等，借花敬佛，望各位改进一下。

;;;功能:圆座标输出
;;;_______________________________________________________
(defun c:no_cirdim (/ cm    osm    hlangue keytime old_error
     *error* t_hig   t_high p2    x_p2    y_p2
     ss    count   n    r_list x_list y_list
     en    ed    cen    cen_list    cen_x
     cen_y   tmp    nou    p1
    )
(setq cm (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq osm (getvar "osmode"))
(setvar "osmode" 0)
(setq hlangue "3")
;;;_______________________________________________________
;;;错误函数
(defun NEWERROR (errmsg)
    (if errmsg    ;当出现错误时
      (progn
(command "_.UNDO" "End") ;编组结束
(setvar "osmode" osm) ;恢复捕捉设置
(setq *error* old_error) ;恢复出错函数
(princ (strcat "\n错误 ==>: "
         errmsg
         " +++"
         "   OSMODE="
         (itoa osm)
        )
)    ;打印错误
      )
    )
)

;;;_______________________________________________________
;;;写入圆孔大小
(defun WRITE_LIST (r_list /)
    (setvar "clayer" "文字层")
    (cond ((= hlangue "1")
    (command "_.text" "j" "C" p1 t_high 0 "序号")
   )
   ((= hlangue "2")
    (command "_.text" "j" "C" p1 t_high 0 "腹")
   )
   ((= hlangue "3")
    (command "_.text" "j" "C" p1 t_high 0 "序号")
   )
    )
    (cond ((= hlangue "1")
    (command "_.text"
      "j"
      "C"
      (polar P1 0 (* t_high 7))
      t_high
      0
      "孔径"
    )
   )
   ((= hlangue "2")
    (command "_.text"
      "j"
      "C"
      (polar P1 0 (* t_high 7))
      t_high
      0
      "ふ畖"
    )
   )
   ((= hlangue "3")
    (command "_.text"
      "j"
      "C"
      (polar P1 0 (* t_high 7))
      t_high
      0
      "孔径"
    )
   )
    )
    (cond ((= hlangue "1")
    (command "_.text"
      "j"
      "C"
      (polar P1 0 (* t_high 16))
      t_high
      0
      "X 座标"
    )
   )
   ((= hlangue "2")
    (command "_.text"
      "j"
      "C"
      (polar P1 0 (* t_high 16))
      t_high
      0
      "X 畒夹"
    )
   )
   ((= hlangue "3")
    (command "_.text"
      "j"
      "C"
      (polar P1 0 (* t_high 16))
      t_high
      0
      "X 座标"
    )
   )
    )
    (cond ((= hlangue "1")
    (command "_.text"
      "j"
      "C"
      (polar P1 0 (* t_high 26))
      t_high
      0
      "Y 座标"
    )
   )
   ((= hlangue "2")
    (command "_.text"
      "j"
      "C"
      (polar P1 0 (* t_high 26))
      t_high
      0
      "Y 畒夹"
    )
   )
   ((= hlangue "3")
    (command "_.text"
      "j"
      "C"
      (polar P1 0 (* t_high 26))
      t_high
      0
      "Y 座标"
    )
   )
    )
    (setq p1 (polar p1 (/ pi -2.0) (* t_high 2)))
    ;(setq n 1)
    (setq n zys)
    (while (/= (setq data (car r_list)) NIL)
      (setq data1 (car x_list))
      (setq data2 (car y_list))
      (command "_.text"
        "j"
        "c"
        (polar P1 0 (* t_high 7))
        t_high
        ""
        (strcat "%%C" (rtos (* (car data) 2.0) 2 2))
      )
      (command "_.text"
        "j"
        "c"
        (polar p1 0 (* t_high 16))
        t_high
        ""
        (rtos (- (car data1) x_p2))
      )
      (command "_.text"
        "j"
        "c"
        (polar p1 0 (* t_high 25))
        t_high
        ""
        (rtos (- (car data2) y_p2))
      )
      (command "_.text"
        "j"
        "C"
        (polar P1 0 (* t_high 0.25))
        t_high
        ""
        (strcat zys1 (rtos n 2 0))
      )
      (setq p1 (polar p1 (/ pi -2.0) (* t_high 2)))
      (setq r_list (cdr r_list))
      (setq x_list (cdr x_list))
      (setq y_list (cdr y_list))
      (setq n (1+ n))
    )
)
;;;_______________________________________________________
;;;画表格
(defun WRITE_LINE (/ ll)
    (setvar "clayer" "0")
    (setq p1 (polar p1 (/ pi 2.0) (* t_high 1.5)))
    (command "_.LINE"
      (polar p1 pi (* t_high 2.5))
      (polar p1 0 (* t_high 30))
      ""
    )
    (command "_.CHANGE" (entlast) "" "P" "Color" "2" "")
    (command "_.ARRAY"
      (entlast)
      ""
      "R"
      (+ (length r_list) 2)
      ""
      (* 2 t_high)
    )
    (command "_.LINE"
      (polar p1 pi (* t_high 2.5))
      (cdr (assoc 10 (entget (entlast))))
      ""
    )
    (command "_.CHANGE" (entlast) "" "P" "Color" "2" "")
    (setq ll (entlast))
    (command "_.COPY" ll "" p1 (polar p1 0 (* t_high 5.0)))
    (command "_.COPY" ll "" p1 (polar p1 0 (* t_high 13.5)))
    (command "_.COPY" ll "" p1 (polar p1 0 (* t_high 23)))
    (command "_.COPY" ll "" p1 (polar p1 0 (* t_high 32.5)))
)
;;;_______________________________________________________
(setq old_error *error*)
(setq *error* NEWERROR)
(command "_.UNDO" "Group")
(command "_.UCS" "World")
(setq zys1 (strcase (getstring "\n 请输入前置代号<A>:")))
(if (= zys1 "") (setq zys1 "A"))
(setq zys (getint "\n 请输入开始序号<1>:"))
(if (= zys nil) (setq zys 1))
(setq count (- zys 1))
(princ "\n文字高度 <")
(setq t_hig (getvar "TEXTSIZE"))
(princ t_hig)
(setq t_high (getstring ">"))
(if (= t_high "")
    (setq t_high t_hig)
    (setq t_high (atof t_high))
)
(setq P2 (getpoint "\n请为尺寸标注指定原点 <0,0,0>:"))
(if (= P2 nil)
    (setq P2 '(0 0 0))
)
(setq x_p2 (car P2))
(setq y_p2 (nth 1 P2))
(prompt "\n请选择===>>>圆")
(setq ss (ssget '((0 . "CIRCLE"))))
;(setq count 0)
(setq n 0)
(setq r_list nil)
(setq x_list nil)
(setq y_list nil)
(repeat (sslength ss)
    (setq en (ssname ss n))
    (setq ed (entget en))
    (if (not (member
        (setq cen (cdr (assoc 10 ed)))
        cen_list
      )
)
      (progn
(setq cen_list (append cen_list (list cen)))
(setq cen_x (list (car cen)))
(setq cen_y (list (cadr cen)))
(setq tmp (cdr (assoc 40 ed)))
(setq r_list (cons (list tmp count) r_list))
(setq x_list (cons cen_x x_list))
(setq y_list (cons cen_y y_list))
(setq count (1+ count))
(setq nou (itoa count))
(setvar "clayer" "文字层")
(command "_.text" "j" "Middle" cen t_high "" (strcat zys1 nou))
      )
    )
    (setq n (1+ n))
)
(setq x_list (reverse x_list))
(setq y_list (reverse y_list))
(setq P1 (getpoint "\n表格插入点<0,0,0>"))
(if (= P1 nil)
    (setq P2 '(0 0 0))
)
(setq r_list (vl-sort r_list
   (function (lambda (e1 e2)
        (< (cadr e1) (cadr e2))
      )
   )
        )
)
(WRITE_LIST r_list)
(WRITE_LINE)
(prompt "\n圆心座标表格式输出，只对圆有效。COMMAND--->>>NO_CIRDIM")
(command "_.UCS" "Prev")
(command "_.UNDO" "end")
(setvar "cmdecho" cm)
(setvar "osmode" osm)
(setq *ERROR* old_error)
(princ)
)

cy956 · 发表于 2009-10-13 22:55:00

(defun cy_px_zbstb ;;(cy_pz_zbstb zbstb k)■k=0先x后y，=1先y后x,完全相同的不消掉
       (zbstb k / IN K K1 KF N X ZB0 ZB1 ZBSTB1 ZBSTB2 ZBSTB3 ZBSTB4)
;;k=0先x后y，=1先y后x,,完全相同的不消掉
(setq zbstb1(cy_px_zbstb0 zbstb k)
k1 nil kf(if (= k 0) 1 0);;相反的k叫kf
zb0(nth 0 zbstb1) zbstb1(cdr zbstb1)
zbstb2 '() zbstb3 (list zb0)
n(length zbstb1) in 0)
(repeat n
    (setq zb1(nth in zbstb1) in(1+ in))
    (if (equal (nth k zb0) (nth k zb1) 0.000001);;说明第一个相等
      (setq zbstb3(append zbstb3 (list zb1)))
      (setq zbstb2(append zbstb2 (list zbstb3))
     zbstb3(list zb1)
     zb0 zb1)
    )
)
(setq zbstb2(append zbstb2 (list zbstb3))
zbstb4(mapcar '(lambda (x) (cy_px_zbstb0 x kf)) zbstb2))
)

(defun cy_px_zbstb0 (zbstb k / K N ZBSTB5);;(cy_px_zbstb0 zbstb k)■针对表内子元素的个数返回排序
(setq n(length zbstb))
(cond
    ((= n 0) (setq zbstb5 '()))
    ((= n 1) (setq zbstb5 zbstb))
    (t (setq zbstb5 (vl-sort zbstb (function (lambda (e1 e2) (< (nth k e1) (nth k e2)))))))
)
zbstb5
)

;;;(setq zbstb '((0 0 "a") (1 1 "b" )(0 3 "c") (-1 1 "d")(1 1 "b" )))
;;;(cy_pz_zbstb zbstb 1);;坐标实体按先y再x的顺序排；从上往下排序
;;;(cy_pz_zbstb zbstb 0);;坐标实体按先x再y的顺序排；从左往右排序

“a”"b""c"可以是实体名，就是你把（（坐标x1 坐标y1 实体名1）（（坐标x2 坐标y2 实体名2）....)这样的表的排序，可以用于已经有的实体的排序更新；

你这个是按点排序，简单一些，（（坐标x1 坐标y1）（（坐标x2 坐标y2）....)即可，按点逐个生成text。

lly2008 · 发表于 2009-10-27 16:02:00

仔细看看，学习一下

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