如何得到選中物體的座標資料???

龙龙仔

是EXPRESSTOOL中的公共函數
(ARXLOAD "ACETUTIL.ARX" NIL)
The acetutil modules (acetutil.arx, acetutil*.fas) provide a number of utility functions which can be called from LISP.


(acet-ent-geomextents ename)
Returns the geometric extents of the given object.

Arguments
ename The entity name of an object.

Return Values
A list containing two points (such as ((1.0 1.0 0.0) (2.0 2.0 0.0))) describing the geometric extents

spring

我的2000早就卸載了,2002有嗎???

龙龙仔

本站應有提供!你找找!

wcpcn

龙龙仔发表于2003-7-23 17:12:00是EXPRESSTOOL中的公共函數

这些帮助从哪儿可以看到？

王咣生

;;
;; trap run-time error.
;;
(defun ai_error (errmsg)
   (if (not (member errmsg '("console break" "Function Cancelled"
        "bad argument type" "Function cancelled" "no function definition: DOS_GETPROGRESS"
          "bad argument" "函数被取消" "quit / exit abort"))
      ) ;_ end of not
      (princ (strcat "\nError: " errmsg))
   )
   (princ)
);_defun

;;
;; Get all nodes of the LWPolyline, Polyline.
;;
(defun GetListOfPline (EntityName / SSE_Pline N newEntityName)
(setq SSE_Pline (entget EntityName))
(setq LastList nil)
(if (= (cdr (assoc 0 SSE_Pline)) "LWPOLYLINE")
    (progn
      (setq LastList (LIST (LIST 0 0)))
      (setq N 0)
      (while (/= (nth N SSE_Pline) nil)
             (if (= (car (nth N SSE_Pline)) 10)
                 (setq LastList (append LastList (list (list (cadr (nth N SSE_Pline)) (caddr (nth N SSE_Pline)) )) ))
             )
             (setq N (+ N 1))
      )
      (setq LastList (cdr LastList))
    )
)
(if (= (cdr (ASSOC 0 SSE_Pline)) "OLYLINE")
    (PROGN
      (setq LastList (list (list 0 0)))
      (setq newEntityName (entnext EntityName))
      (while (= (cdr (assoc 0 (entget newEntityName))) "VERTEX")
             (setq LastList (append LastList (list (list (cadr (assoc 10 (entget newEntityName))) (caddr (assoc 10 (entget newEntityName))) ))))
             (setq newEntityName (entnext newEntityName))
      )
      (setq LastList (cdr LastList))
    )
)
(setq LastList LastList)
);_defun

;;
;; main function
;;
(defun c:maxmin ( / old_cmd old_osm sel_set i pt_list rad cen x0 y0 pt_minx pt_miny pt_maxx pt_maxy cen_x cen_y ret_val)
  (setq old_cmd (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (setq old_osm (getvar "osmode"))
  (setvar "osmode" 0)
  (setq old_error  *error*                ; save current error function
        *error* ai_error                ; new error function
  )
  (prompt "\nSelect entity:")
  (setq sel_set (ssget))
  (if sel_set
    (progn
      (setq i 0)
      (repeat (sslength sel_set)
        (setq ent_name (ssname sel_set i))
        (setq ent_list (entget ent_name))
        (cond
          ((or (= (cdr (assoc 0 ent_list)) "LWPOLYLINE")(= (cdr (assoc 0 ent_list)) "OLYLINE"))
           (setq pt_list (append pt_list (GetListOfPline ent_name)))
          )
          ((= (cdr (assoc 0 ent_list)) "CIRCLE")
           (setq rad (cdr (assoc 40 ent_list)))
           (setq cen (cdr (assoc 10 ent_list)))
           (setq x0 (car cen)
                 y0 (cadr cen)
                 )
           (setq pt_list (append pt_list (list (list (- x0 rad) (+ y0 rad))(list (+ x0 rad) (- y0 rad)))))
          )
          (t)
        );_cond
        (setq i (+ i 1))
      );_repeat
      (if pt_list
        (progn
          (setq pt_minx (apply 'min (mapcar 'car pt_list))
                pt_miny (apply 'min (mapcar 'cadr pt_list))
                pt_maxx (apply 'max (mapcar 'car pt_list))
                pt_maxy (apply 'max (mapcar 'cadr pt_list))
                cen_x (/ (+ pt_minx pt_maxx) 2)
                  cen_y (/ (+ pt_miny pt_maxy) 2)
          )
          (setq ret_val (list (cons "10" (list pt_minx pt_miny))
                              (cons "11" (list pt_maxx pt_maxy))
                              (cons "cen" (list cen_x cen_y))
                        )
          )
        )
        (princ "\nNo 'Polyline' or 'Circle' entity!")
      );_if
    );_progn
    (alert "No entities selected!")
  );_if
  
  ; Draw a rectangle to mark the range of the selected entities( Pline or Circle).
  (if (and ret_val (/= (cdr (car ret_val)) (cdr (cadr ret_val))))
    (progn
      (command "rectang" (cdr (car ret_val)) (cdr (cadr ret_val)) 3)
    )
  );_if
  
  (setvar "cmdecho" old_cmd)
  (setvar "osmode" old_osm)
  (setq *error* old_error)
  (princ)
  ret_val        ;return list.
);_defun

包含三个函数:
  1. ai_error 错误跟踪;
  2.GetListOfPline 计算多义线坐标;
  3.c:maxmin 主函数.

王咣生

我发的帖子,很长时间看不到?只好再发一次.什么原因呢?

meflying

可能你没有刷新吧

王咣生

谢谢meflying版主奖励的积分.

spring

謝謝咣生兄的回答.
以前前生寫的一個程序,找了好久才找到,不過我的腦袋瓜太笨了,看不懂.
;;;______________________________________________________
(defun c:myy ()
  (Defun my (ben / count doc handles l1 l2 count y1 y2)
    (setq count 0)
    (setq lyx nil)
    (setq lyy nil)
    (SetQ doc (VLA-Get-ActiveDocument (VLAX-Get-ACAD-Object)))
    (while (< count (sslength ben))
      (setq ent1 (ssname ben count))
      (Setq
        handles
         (Cdr (Assoc 5 (EntGet ent1)))
      )
      (VLA-GetBoundingBox
        (VLA-HandleToObject doc handles)
        'llp
        'urp
      )
      (setq l1 (VLAX-SafeArray->List llp))
      (setq lyx (cons (Car l1) lyx))
      (setq lyy (cons (Cadr l1) lyy))
      (setq l2 (VLAX-SafeArray->List urp))
      (setq lyx (cons (Car l2) lyx))
      (setq lyy (cons (Cadr l2) lyy))
      (setq count (1+ count))
    )
    (setq lyx (vl-sort lyx '<))
    (setq lyy (vl-sort lyy '<))
  )
  (setq ss (ssget))
;;;__________________________________________
  (my ss)
)

spring

王咣生发表于2003-7-24 11:43:00再上传
372

我发的帖子,很长时间看不到?只好再发一次.什么原因呢?

我有有過類試的情況,有時候貼子找不到了,必須要搜索才可以