[分享]：点取实体,使之显示于对话框image筐中

aeo · 发表于 2003-5-22 23:41:41

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

下面:

;;; '(pa pb pc pd...px) --> '(pa pb pb pc pc pd...px)
(defun li-vector-li (ss / a b ss1)
(setq a (car ss)
b (last ss)
ss (cdr ss)
ss (reverse (cdr (reverse ss)))
)
(mapcar '(lambda (x)(repeat 2(setq ss1 (cons x ss1)))) ss)
(cons a (reverse (cons b ss1)))
)
;;;
(defun my-vector_image (name ss sca color1 color2 / a box en midp ptn x y
trans_image 2-3d yes b li-shx2pl ss1 lst2sel
dxf )
(defun lst2sel(l / ss)(setq ss (ssadd))(foreach e l (ssadd e ss)))
(defun dxf(a b)(cdr(assoc a b)))
(defun li-shx2pl (str pt high bl / j len li li1 no pt s)
(setq li '())
(setq len (strlen str)
j 1
)
(while (<= j len)
(if (> (ascii (substr str j)) 140)
(setq no 2)
(setq no 1)
)
(setq s (substr str j no))
(setq li1 (xdrx_shx2pl s pt high bl "simplex" "hztxt"))
(setq pt (polar pt 0 (* high bl)) li1 (cdr li1))
(setq li (append li li1 ))
(setq j (+ j no))
)
li
)
(defun trans_image (ptn box midp x y sca / bl midxy p0 x1 xform xform1
xform2 xform3 y1 str pt hi gn color
)
(setq y1 (distance (car box) (last box))
x1 (distance (car box) (cadr box))
)
(if (< y1 1e-3) (setq y1 y))
(if (< x1 1e-3) (setq x1 x))
(setq bl (if (< (/ x x1) (/ y y1))
(/ x x1)
(/ y y1)
)
)
(setq bl (* bl sca))
(setq midxy (list (/ x 2.0) (/ y 2.0) 0))
(setq p0 (mapcar '(lambda (x y) (- x y)) midxy midp ) )
(setq xForm (xdrx_matrix_identity 3))
(setq xform1 (xdrx_matrix_setTransLation xForm p0))
(setq ptn (mapcar '(lambda (x) (xdrx_point_transform x xform1) )ptn ))
(setq xform2 (mapcar
'(lambda (x)
(xdrx_matrix_setScale xform bl midxy)
)
ptn
)
)
(setq ptn (mapcar
'(lambda (x y)
(xdrx_point_transform x y)
)
ptn
xform2
)
)
(setq xform3 (mapcar
'(lambda (x)
(xdrx_matrix_setMirror xform (list midxy (polar midxy 0 1))
)
)
ptn
)
)
(setq ptn (mapcar
'(lambda (x y)
(xdrx_point_transform x y)
)
ptn xform3
)
)
)
(defun 2-3d (p)(list (car p) (cadr p) 0))
(cond
((and
(listp ss)
(= (type (car ss)) 'ename)
)
(setq ss (lst2sel ss)
yes 1
)
)
((= (type ss) 'ename)
(setq ss (lst2sel (list ss))
yes 1
)
)
((= (type ss) 'pickset)
(setq yes 1)
)
((and
(listp ss)
(listp (car ss))
)
(setq yes 2)
)
((= (type ss) 'str)
(setq ss(list(list color2 (li-shx2pl ss '(0 0) 600 0.8)))
yes 2
)
)
)
(cond
((= 1 yes)
(setq box (xdrx_entity_box ss))
(setq midp (list (/ (+ (car (caddr box)) (car (car box))) 2)
(/ (+ (cadr (caddr box)) (cadr (car box))) 2) 0
)
)
(start_image name)
(setq x (dimx_tile name)
y (dimy_tile name)
)
(fill_image 0 0 x y color1)
(setq j 0 len(sslength ss))
(while(< j len)
(setq e(ssname ss j))
(if (not color2)
(if (not (dxf 62 (entget e)))
(setq color (dxf 62 (tblsearch "layer" (dxf 8 (entget e)))))
(setq color (dxf 62 (entget e)))
)
(setq color color2)
)
(cond
((= "TEXT" (dxf 0 (setq ee (entget e))))
(setq str (dxf 1 ee)
pt (dxf 10 ee)
hi (dxf 40 ee)
gn (dxf 41 ee)
)
(setq en (li-shx2pl str pt hi gn))
)
(t
(setq en (xdrx_getsamplept e)
en (li-vector-li en))
)
)
(setq en (mapcar '2-3d en ))
(setq ptn (trans_image en box midp x y sca))
(while (cdr ptn)
(setq a (car ptn)
b (cadr ptn)
)
(vector_image (fix (car a)) (fix (cadr a)) (fix (car b))
(fix (cadr b)) color
)
(setq ptn (cddr ptn))
)(setq j(1+ j))
)
(end_image)
)
((= 2 yes) ; li 已经为--> '((color1(pa pb pb pc pc pd......))(color2(pa pb pb ...)))
(setq ss1 '())
(foreach x ss (setq ss1 (append(cadr x) ss1)))
(setq box (apply 'xdrx_pointsbox ss1) )
(setq midp (list (/ (+ (car (caddr box)) (car (car box))) 2)
(/ (+ (cadr (caddr box)) (cadr (car box))) 2) 0
)
)
(start_image name)
(setq x (dimx_tile name)
y (dimy_tile name)
)
(fill_image 0 0 x y color1)
(foreach li ss
(setq ptn (mapcar '2-3d (cadr li) ) color2(car li) )
(setq ptn (trans_image ptn box midp x y sca))
(while (cdr ptn)
(setq a (car ptn)
b (cadr ptn)
)
(vector_image (fix (car a)) (fix (cadr a)) (fix (car b))
(fix (cadr b)) color2
)
(setq ptn (cddr ptn))
)
)
(end_image)
)
)
)

;;;  '(pa pb pc pd...px)  -->  '(pa pb pb pc pc pd...px) 
(defun li-vector-li (ss / a b ss1) 
  (setq a (car ss) 
        b (last ss) 
        ss (cdr ss) 
        ss (reverse (cdr (reverse ss))) 
  ) 
  (mapcar '(lambda (x)(repeat 2(setq ss1 (cons x ss1)))) ss) 
  (cons a (reverse (cons b ss1))) 
) 
;;; 
(defun my-vector_image (name ss sca color1 color2 / a box en midp ptn x y 
                             trans_image 2-3d yes b li-shx2pl ss1 lst2sel 
                      dxf ) 
 (defun lst2sel(l / ss)(setq ss (ssadd))(foreach e l (ssadd e ss))) 
 (defun dxf(a b)(cdr(assoc a b)))                
  (defun li-shx2pl (str pt high bl / j len li li1 no pt s) 
    (setq li '()) 
    (setq len (strlen str) 
          j 1 
    ) 
    (while (<= j len) 
      (if (> (ascii (substr str j)) 140) 
        (setq no 2) 
        (setq no 1) 
      ) 
      (setq s (substr str j no)) 
      (setq li1 (xdrx_shx2pl s pt high bl "simplex" "hztxt")) 
      (setq pt (polar pt 0 (* high bl)) li1 (cdr li1))                                     
      (setq li (append li li1  )) 
      (setq j (+ j no)) 
    ) 
    li 
  )                                        
  (defun trans_image (ptn box midp x y sca / bl midxy p0 x1 xform xform1 
                         xform2 xform3 y1 str pt hi gn color 
                    ) 
    (setq y1 (distance (car box) (last box)) 
          x1 (distance (car box) (cadr box)) 
    ) 
    (if (< y1 1e-3) (setq y1 y)) 
    (if (< x1 1e-3) (setq x1 x)) 
    (setq bl (if (< (/ x x1) (/ y y1)) 
               (/ x x1) 
               (/ y y1) 
             ) 
    ) 
    (setq bl (* bl sca)) 
    (setq midxy (list (/ x 2.0) (/ y 2.0) 0)) 
    (setq p0 (mapcar '(lambda (x y)  (- x y)) midxy midp ) ) 
    (setq xForm (xdrx_matrix_identity 3)) 
    (setq xform1 (xdrx_matrix_setTransLation xForm p0)) 
    (setq ptn (mapcar '(lambda (x) (xdrx_point_transform x xform1) )ptn )) 
    (setq xform2 (mapcar 
                   '(lambda (x) 
                      (xdrx_matrix_setScale xform bl midxy) 
                    ) 
                   ptn 
                 ) 
    ) 
    (setq ptn (mapcar 
                '(lambda (x y) 
                   (xdrx_point_transform x y) 
                 ) 
                ptn 
                xform2 
              ) 
    ) 
    (setq xform3 (mapcar 
                   '(lambda (x) 
                      (xdrx_matrix_setMirror xform (list midxy (polar midxy 0 1)) 
                      ) 
                    ) 
                   ptn 
                 ) 
    ) 
    (setq ptn (mapcar 
                '(lambda (x y) 
                   (xdrx_point_transform x y) 
                 ) 
                ptn xform3 
              ) 
    ) 
  )                                      
  (defun 2-3d (p)(list (car p) (cadr p) 0))                                        
  (cond 
    ((and 
       (listp ss) 
       (= (type (car ss)) 'ename) 
     ) 
      (setq ss (lst2sel ss) 
            yes 1 
      ) 
    ) 
    ((= (type ss) 'ename) 
      (setq ss (lst2sel (list ss)) 
            yes 1 
      ) 
    ) 
    ((= (type ss) 'pickset) 
      (setq yes 1) 
    ) 
    ((and 
       (listp ss) 
       (listp (car ss)) 
     ) 
      (setq yes 2) 
    ) 
    ((= (type ss) 'str) 
      (setq ss(list(list color2 (li-shx2pl ss '(0 0) 600 0.8))) 
            yes 2 
      ) 
    ) 
  ) 
 
  (cond 
    ((= 1 yes) 
      (setq box (xdrx_entity_box ss)) 
      (setq midp (list (/ (+ (car (caddr box)) (car (car box))) 2) 
                       (/ (+ (cadr (caddr box)) (cadr (car box))) 2) 0 
                 ) 
      ) 
      (start_image name) 
      (setq x (dimx_tile name) 
            y (dimy_tile name) 
      ) 
      (fill_image 0 0 x y color1) 
     (setq j 0 len(sslength ss)) 
     (while(< j len) 
      (setq e(ssname ss j)) 
        (if (not color2) 
          (if (not (dxf 62 (entget e))) 
            (setq color (dxf 62 (tblsearch "layer" (dxf 8 (entget e))))) 
            (setq color (dxf 62 (entget e))) 
          ) 
          (setq color color2) 
        ) 
        (cond 
          ((= "TEXT" (dxf 0 (setq ee (entget e)))) 
            (setq str (dxf 1 ee) 
                  pt (dxf 10 ee) 
                  hi (dxf 40 ee) 
                  gn (dxf 41 ee) 
            ) 
            (setq en (li-shx2pl str pt hi gn)) 
          ) 
          (t 
            (setq en (xdrx_getsamplept e) 
                  en (li-vector-li en)) 
          ) 
        ) 
        (setq en (mapcar '2-3d en )) 
        (setq ptn (trans_image en box midp x y sca)) 
        (while (cdr ptn) 
          (setq a (car ptn) 
                b (cadr ptn) 
          ) 
          (vector_image (fix (car a)) (fix (cadr a)) (fix (car b)) 
                        (fix (cadr b)) color 
          ) 
          (setq ptn (cddr ptn)) 
        )(setq j(1+ j)) 
      ) 
      (end_image) 
    ) 
    ((= 2 yes)     ; li 已经为--> '((color1(pa pb pb pc pc pd......))(color2(pa pb pb ...))) 
     (setq ss1 '()) 
     (foreach x ss (setq ss1 (append(cadr x) ss1))) 
      (setq box (apply 'xdrx_pointsbox  ss1) ) 
      (setq midp (list (/ (+ (car (caddr box)) (car (car box))) 2) 
                       (/ (+ (cadr (caddr box)) (cadr (car box))) 2) 0 
                 ) 
      ) 
      (start_image name) 
      (setq x (dimx_tile name) 
            y (dimy_tile name) 
      ) 
      (fill_image 0 0 x y color1) 
    (foreach li ss 
      (setq ptn (mapcar '2-3d (cadr li) ) color2(car li) ) 
      (setq ptn (trans_image ptn box midp x y sca)) 
      (while (cdr ptn) 
        (setq a (car ptn) 
              b (cadr ptn) 
        ) 
        (vector_image (fix (car a)) (fix (cadr a)) (fix (car b)) 
                      (fix (cadr b)) color2 
        ) 
        (setq ptn (cddr ptn)) 
      ) 
    ) 
      (end_image) 
    ) 
  ) 
)

aeo · 发表于 2003-5-22 23:43:05

下面试验:

(defun c:www (/ a b id_dia ss ss1 what no color)
(prompt "\n这里做个试验--by AEO,填充image框的0.9倍,底色为0,线颜色1&2随物体3&4为1.")
(prompt "\n1-选择集,2-entsel,3-点表,4-字符串:")
(setq no (getstring))
(cond
((= no "1")
(prompt "\n这里只能"*line,arc,circle,ellipse,text" ")
(setq ss (ssget '((0 . "*line,arc,circle,ellipse,text"))))
(setq color nil)
)
((= no "2")
(prompt "\n这里只能"*line,arc,circle,ellipse,text" ")
(setq ss (car (entsel)))
(setq color nil)
)
((= no "3")
(prompt "\n这里用"xdrx_getsamplept"生成点表,颜色从1递增")
(setq color 1 ss '() )
(while(setq e(car(entsel)))
(if(setq ss1 (xdrx_getsamplept e))
(setq ss (cons(list color(li-vector-li ss1)) ss))
)
(setq color(1+ color))
) (setq ss1 ss)
)
((= no "4")
(setq ss (getstring "\n输入字符串:"))
(setq color 1)
)
)
(if (and ss (/= ss ""))
(progn
(if (< (setq id_dia (load_dialog "zlj-zw.dcl")) 0 )(exit))
(new_dialog "zlj_zw" id_dia)
(my-vector_image "yy" ss 0.9 0 color)
(action_tile "cancel" "(done_dialog 0)")
(setq what (start_dialog))
(unload_dialog id_dia)
)
)

(defun c:www (/ a b id_dia ss  ss1 what no color) 
  (prompt "\n这里做个试验--by AEO,填充image框的0.9倍,底色为0,线颜色1&2随物体3&4为1.") 
  (prompt "\n1-选择集,2-entsel,3-点表,4-字符串:") 
  (setq no (getstring)) 
  (cond 
    ((= no "1") 
      (prompt "\n这里只能"*line,arc,circle,ellipse,text" ") 
      (setq ss (ssget '((0 . "*line,arc,circle,ellipse,text")))) 
      (setq color nil) 
    ) 
    ((= no "2") 
      (prompt "\n这里只能"*line,arc,circle,ellipse,text" ") 
      (setq ss (car (entsel))) 
      (setq color nil) 
    ) 
    ((= no "3") 
      (prompt "\n这里用"xdrx_getsamplept"生成点表,颜色从1递增") 
      (setq color 1 ss '() ) 
      (while(setq e(car(entsel))) 
       (if(setq ss1 (xdrx_getsamplept e)) 
          (setq ss (cons(list color(li-vector-li ss1)) ss)) 
       ) 
       (setq color(1+ color)) 
      ) (setq ss1 ss) 
    ) 
    ((= no "4") 
      (setq ss (getstring "\n输入字符串:")) 
      (setq color 1) 
    )    
  ) 
  (if (and ss (/= ss "")) 
    (progn 
      (if (< (setq id_dia (load_dialog "zlj-zw.dcl")) 0 )(exit)) 
      (new_dialog "zlj_zw" id_dia) 
      (my-vector_image "yy" ss 0.9 0 color) 
      (action_tile "cancel" "(done_dialog 0)") 
      (setq what (start_dialog)) 
      (unload_dialog id_dia) 
    ) 
  )

aeo · 发表于 2003-5-22 23:49:04

用法:

(my-vector_image name ss sca color1 color2 )
name:image框key
ss:选择集,或曲线(文字也可),或点表,或字符
sca:在image里占的比例
color1:底色
color2:要显示的颜色

复制代码

切记:选的东西不要太多,特别是带弧的
试验的dcl见下

XDSoft · 发表于 2003-5-22 23:50:59

最初由 aeo 发布
[B]下面试验:
[code]
(defun c:www (/ a b id_dia ss  ss1 what no color)
  (prompt "\n这里做个试验--by AEO,填充image框的0.9倍,底色为0,线颜色1&2随物体3&4为1.")
  (prompt "\n1-选择集,2-entsel,3-点表,4-字?.. [/B]

XDRX_API 还有更方便的函数, 直接在图形和DCL坐标系进行矩阵变换,得到DCL IMAGE的数据的函数.
就如天正,理正的一些图形对话框应用,分两类,一类是可以动态变换,如柱子,另一类是固定,如楼梯等等.

以后我会给大家写教学.

aeo · 发表于 2003-5-22 23:55:20

我用的,不是特别好,经常只占image的一半,(可能我不会用)
要实体进去,还是要转的.

无心快语 · 发表于 2003-5-23 00:12:59

用来干什么的?只是显示么?

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

[分享]：点取实体,使之显示于对话框image筐中

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子

浏览过的版块