API应用图块标注

eachy · 发表于 2013-11-14 20:36:45

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

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

×

帮一个朋友临时写的

(defun c:tt1 (/ sortent tss bss tl bnl)
(defun sortent (ss)
(vl-sort (xdrx_pickset->ents ss)
'(lambda (e1 e2)
(> (cadr (xdrx_getpropertyvalue e1 "Position"))
(cadr (xdrx_getpropertyvalue e2 "Position"))
)
)
)
)
(if (and (progn
(princ "\n选择序号列或名称列....")
(setq tss (ssget '((0 . "text"))))
)
(progn
(princ "\n选择图例列.....")
(setq bss (ssget '((0 . "insert"))))
)
)
(progn
(princ "\n请稍候，正在全图处理......")
(setq tl (mapcar
'(lambda (x) (xdrx_getpropertyvalue x "Textstring"))
(sortent tss)
)
bnl (mapcar '(lambda (x)
(car (xdrx_getpropertyvalue x "BlockTableRecord"))
)
(sortent bss)
)
)
(mapcar '(lambda (x y / ss)
(if (setq ss (ssget "x" (list (cons 2 x))))
(mapcar '(lambda (a)
(xdrx_xdata_set a "XDLHBZ" y)
)
(xdrx_pickset->ents ss)
)
)
)
bnl
tl
)
(princ "\nAll is Ok, 可以执行标注命令了!")
)
)
(princ)
)
(defun c:tt (/ e bn ss el pts p p1 zh str l pl txt tp an p2)
(while
(and (setq e (car (xdrx_entsel
"\n点选特征块: "
'((0 . "INSERT") (-3 ("XDLHBZ")))
)
)
)
(setq bn (xdrx_getentdxf 2))
(setq ss (ssget (list (cons 2 bn))))
)
(setq
pts (mapcar '(lambda (x) (xdrx_getpropertyvalue x "Position"))
(xdrx_pickset->ents ss)
)
pts (vl-sort pts
'(lambda (p1 p2)
(if (= (car p1) (car p2))
(< (cadr p1) (cadr p2))
(< (car p1) (car p2))
)
)
)
p (car pts)
zh (getvar "textsize")
str (strcat (car (xdrx_xdata_get e "XDLHBZ"))
"("
(rtos (sslength ss) 2 0)
"株)"
)
l (XD::String:ActualWidth str "" zh 0.8)
)
(setq pl (apply 'xdrx_polyline_make pts))
(if (and (setq p1 (getpoint p "\n标注点: "))
(progn
(xdrx_grdraw -2 1 p p1)
t
)
(setq p2 (getpoint p1 "\n方向: "))
)
(progn
(setq an (angle p1 p2))
(if (or (<= an (/ pi 2))
(>= an (* 1.5 pi))
)
(setq an 0.
tp (mapcar '+ p1 '(500. 500. 0))
)
(setq an pi
tp (mapcar '+ p1 '(-500. 500. 0.))
)
)
(xdrx_polyline_setpointat pl 0 (polar p1 an (+ l 2000.)))
(xdrx_polyline_addvertexat pl 1 p1)
(xdrx_polyline_addvertexat pl 2 p)
(setq txt (xdrx_text_make
tp
str
zh
0.
)
)
(if (= an pi)
(xdrx_text_sethozmode txt 2)
)
(xdrx_group_make "*" pl txt)
)
)
)
(princ)
)

(defun c:tt1 (/ sortent tss bss tl bnl) 
  (defun sortent (ss) 
    (vl-sort (xdrx_pickset->ents ss) 
             '(lambda (e1 e2) 
                (> (cadr (xdrx_getpropertyvalue e1 "Position")) 
                   (cadr (xdrx_getpropertyvalue e2 "Position")) 
                ) 
              ) 
    ) 
  ) 
  (if (and (progn 
             (princ "\n选择序号列或名称列....") 
             (setq tss (ssget '((0 . "text")))) 
           ) 
           (progn 
             (princ "\n选择图例列.....") 
             (setq bss (ssget '((0 . "insert")))) 
           ) 
      ) 
    (progn 
      (princ "\n请稍候，正在全图处理......") 
      (setq tl        (mapcar 
                  '(lambda (x) (xdrx_getpropertyvalue x "Textstring")) 
                  (sortent tss) 
                ) 
            bnl        (mapcar        '(lambda (x) 
                           (car (xdrx_getpropertyvalue x "BlockTableRecord")) 
                         ) 
                        (sortent bss) 
                ) 
      ) 
      (mapcar '(lambda (x y / ss) 
                 (if (setq ss (ssget "x" (list (cons 2 x)))) 
                   (mapcar '(lambda (a) 
                              (xdrx_xdata_set a "XDLHBZ" y) 
                            ) 
                           (xdrx_pickset->ents ss) 
                   ) 
                 ) 
               ) 
              bnl 
              tl 
      ) 
      (princ "\nAll is Ok, 可以执行标注命令了!") 
    ) 
  ) 
  (princ) 
) 
(defun c:tt (/ e bn ss el pts p p1 zh str l pl txt tp an p2) 
  (while 
    (and (setq e (car (xdrx_entsel 
                        "\n点选特征块: " 
                        '((0 . "INSERT") (-3 ("XDLHBZ"))) 
                      ) 
                 ) 
         ) 
         (setq bn (xdrx_getentdxf 2)) 
         (setq ss (ssget (list (cons 2 bn)))) 
    ) 
     (setq 
       pts (mapcar '(lambda (x) (xdrx_getpropertyvalue x "Position")) 
                   (xdrx_pickset->ents ss) 
           ) 
       pts (vl-sort pts 
                    '(lambda (p1 p2) 
                       (if (= (car p1) (car p2)) 
                         (< (cadr p1) (cadr p2)) 
                         (< (car p1) (car p2)) 
                       ) 
                     ) 
           ) 
       p   (car pts) 
       zh  (getvar "textsize") 
       str (strcat (car (xdrx_xdata_get e "XDLHBZ")) 
                   "(" 
                   (rtos (sslength ss) 2 0) 
                   "株)" 
           ) 
       l   (XD::String:ActualWidth str "" zh 0.8) 
     ) 
     (setq pl (apply 'xdrx_polyline_make pts)) 
     (if (and (setq p1 (getpoint p "\n标注点: ")) 
              (progn 
                (xdrx_grdraw -2 1 p p1) 
                t 
              ) 
              (setq p2 (getpoint p1 "\n方向: ")) 
         ) 
       (progn 
         (setq an (angle p1 p2)) 
         (if (or (<= an (/ pi 2)) 
                 (>= an (* 1.5 pi)) 
             ) 
           (setq an 0. 
                 tp (mapcar '+ p1 '(500. 500. 0)) 
           ) 
           (setq an pi 
                 tp (mapcar '+ p1 '(-500. 500. 0.)) 
           ) 
         ) 
         (xdrx_polyline_setpointat pl 0 (polar p1 an (+ l 2000.))) 
         (xdrx_polyline_addvertexat pl 1 p1) 
         (xdrx_polyline_addvertexat pl 2 p) 
         (setq txt (xdrx_text_make 
                     tp 
                     str 
                     zh 
                     0. 
                   ) 
         ) 
         (if (= an pi) 
           (xdrx_text_sethozmode txt 2) 
         ) 
         (xdrx_group_make "*" pl txt) 
       ) 
     ) 
  ) 
  (princ) 
)

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

[每日一码] API应用图块标注

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

浏览过的版块

[每日一码] API应用 图块标注

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

浏览过的版块

[每日一码] API应用图块标注