智能标注

st788796 · 发表于 2014-9-29 12:01:32

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

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

×

本帖最后由 st788796 于 2014-10-1 19:53 编辑

(defun c:XDTB_AutoDim (/ _getdimline _setrotation
_getpoint callback bp1 bp2
an1 an2 dm _highlight
myerr
)
(defun myerr (msg)
(princ "\n*取消*")
(xdrx_pointmonitor)
(if dm
(xdrx_entity_delete dm)
)
(mapcar '(lambda (x)
(if x
(xdrx_pickset_highlight (cadr x) t)
)
)
(list an1 an2)
)
(setq *error* olderr
myerr nil
)
(princ)
)
(defun _getdimline (p msg / ss e _result)
(defun _result (line /)
(list (rem (xdrx_getpropertyvalue line "angle") pi)
line
)
)
(if (setq ss (xdrx_pickset_getatpoint p '((0 . "line"))))
(cond
((= (sslength ss) 1)
(_result (ssname ss 0))
)
((> (sslength ss) 1)
(xdrx_pickset_highlight ss)
(if (setq e (xdrx_entsel msg '((0 . "line"))))
(progn
(xdrx_pickset_highlight ss t)
(_result (car e))
)
)
)
(t nil)
)
)
)
(defun _highlight (e e0 mod)
(if mod
(mapcar '(lambda (x)
(if x
(xdrx_pickset_highlight x t)
)
)
(list e e0)
)
(progn
(if e0
(xdrx_pickset_highlight e0)
)
(if e
(xdrx_pickset_highlight e t)
)
)
)
)
(defun _setrotation (dPnt thisPnt ortherPnt lineAng
ent ent1 / pan
_dimstatus
)
(defun _dimstatus (e1 e2 mod col ang /)
(_highlight e1 e2 mod)
(_highlight e2 e1 mod)
(xdrx_entity_setcolor dm col)
(xdrx_setpropertyvalue dm "rotation" ang)
)
(if lineAng
(progn
(setq pan (rem (angle thisPnt dPnt) pi))
(cond
((equal pan lineAng 0.1)
(_dimstatus ent ent1 nil 1 (+ (/ pi 2) lineAng))
)
((equal (abs (- pan lineAng)) (/ pi 2) 0.1)
(_dimstatus ent ent1 t 1 lineAng)
)
((equal (abs (- pan (angle thisPnt ortherPnt))) (/ pi 2) 0.1)
(_dimstatus ent ent1 t 3 (angle thisPnt ortherPnt))
)
((equal pan 0.0 0.1)
(_dimstatus ent ent1 t 4 (/ pi 2))
)
((equal pan (/ pi 2) 0.1)
(_dimstatus ent entl t 5 0.)
)
(t)
)
)
)
)
(defun callback (dynpt /)
(if (< (distance dynpt bp1) (distance dynpt bp2))
(_setrotation dynpt bp1 bp2 (car an1) (cadr an1) (cadr an2))
(_setrotation dynpt bp2 bp1 (car an2) (cadr an2) (cadr an1))
)
(xdrx_setpropertyvalue dm "dimlinepoint" dynpt)
)
(defun _getpoint (pnt lst bp / pnt an)
(if (and (setq p (if bp
(getpoint bp "\n标注点: ")
(getpoint "\n标注点: ")
)
)
(progn
(setq an (_getdimline p "\n对齐线: "))
t
)
)
(progn
(set pnt p)
(set lst an)
t
)
)
)
(setq olderr *error*
*error* myerr
)
(xdrx_begin)
(if (and (_getpoint 'bp1 'an1 nil)
(_getpoint 'bp2 'an2 bp1)
)
(progn
(setq dm (xdrx_dimension_makerotate
bp1
bp2
(polar bp1 0. (* (distance bp1 bp2) 0.1))
0.0
)
)
(xdrx_pointmonitor "callback" dm)
(getpoint "\n位置: ")
(xdrx_pointmonitor)
(xdrx_entity_setcolor dm 0)
(_highlight (cadr an1) (cadr an2) t)
)
)
(xdrx_end)
(setq *error* olderr
myerr nil
)
(princ)
)

(defun c:XDTB_AutoDim (/          _getdimline                _setrotation 
                       _getpoint  callback   bp1        bp2 
                       an1          an2             dm                _highlight 
                       myerr 
                      ) 
  (defun myerr (msg) 
    (princ "\n*取消*") 
    (xdrx_pointmonitor) 
    (if        dm 
      (xdrx_entity_delete dm) 
    ) 
    (mapcar '(lambda (x) 
               (if x 
                 (xdrx_pickset_highlight (cadr x) t) 
               ) 
             ) 
            (list an1 an2) 
    ) 
    (setq *error* olderr 
          myerr          nil 
    ) 
    (princ) 
  ) 
  (defun _getdimline (p msg / ss e _result) 
    (defun _result (line /) 
      (list (rem (xdrx_getpropertyvalue line "angle") pi) 
            line 
      ) 
    ) 
    (if        (setq ss (xdrx_pickset_getatpoint p '((0 . "line")))) 
      (cond 
        ((= (sslength ss) 1) 
         (_result (ssname ss 0)) 
 
        ) 
        ((> (sslength ss) 1) 
         (xdrx_pickset_highlight ss) 
         (if (setq e (xdrx_entsel msg '((0 . "line")))) 
           (progn 
             (xdrx_pickset_highlight ss t) 
             (_result (car e)) 
           ) 
         ) 
        ) 
        (t nil) 
      ) 
    ) 
  ) 
  (defun _highlight (e e0 mod) 
    (if        mod 
      (mapcar '(lambda (x) 
                 (if x 
                   (xdrx_pickset_highlight x t) 
                 ) 
               ) 
              (list e e0) 
      ) 
      (progn 
        (if e0 
          (xdrx_pickset_highlight e0) 
        ) 
        (if e 
          (xdrx_pickset_highlight e t) 
        ) 
      ) 
    ) 
  ) 
  (defun _setrotation (dPnt         thisPnt   ortherPnt lineAng 
                       ent         ent1           /             pan 
                       _dimstatus 
                      ) 
    (defun _dimstatus (e1 e2 mod col ang /) 
      (_highlight e1 e2 mod) 
      (_highlight e2 e1 mod) 
      (xdrx_entity_setcolor dm col) 
      (xdrx_setpropertyvalue dm "rotation" ang) 
    ) 
    (if        lineAng 
      (progn 
        (setq pan (rem (angle thisPnt dPnt) pi)) 
        (cond 
          ((equal pan lineAng 0.1) 
           (_dimstatus ent ent1 nil 1 (+ (/ pi 2) lineAng)) 
          ) 
          ((equal (abs (- pan lineAng)) (/ pi 2) 0.1) 
           (_dimstatus ent ent1 t 1 lineAng) 
          ) 
          ((equal (abs (- pan (angle thisPnt ortherPnt))) (/ pi 2) 0.1) 
           (_dimstatus ent ent1 t 3 (angle thisPnt ortherPnt)) 
          ) 
          ((equal pan 0.0 0.1) 
           (_dimstatus ent ent1 t 4 (/ pi 2)) 
          ) 
          ((equal pan (/ pi 2) 0.1) 
           (_dimstatus ent entl t 5 0.) 
          ) 
          (t) 
        ) 
      ) 
    ) 
  ) 
  (defun callback (dynpt /) 
    (if        (< (distance dynpt bp1) (distance dynpt bp2)) 
      (_setrotation dynpt bp1 bp2 (car an1) (cadr an1) (cadr an2)) 
      (_setrotation dynpt bp2 bp1 (car an2) (cadr an2) (cadr an1)) 
    ) 
    (xdrx_setpropertyvalue dm "dimlinepoint" dynpt) 
  ) 
 
  (defun _getpoint (pnt lst bp / pnt an) 
    (if        (and (setq p (if bp 
                       (getpoint bp "\n标注点: ") 
                       (getpoint "\n标注点: ") 
                     ) 
             ) 
             (progn 
               (setq an (_getdimline p "\n对齐线: ")) 
               t 
             ) 
        ) 
      (progn 
        (set pnt p) 
        (set lst an) 
        t 
      ) 
    ) 
  ) 
  (setq        olderr        *error* 
        *error*        myerr 
  ) 
  (xdrx_begin) 
  (if (and (_getpoint 'bp1 'an1 nil) 
           (_getpoint 'bp2 'an2 bp1) 
      ) 
    (progn 
      (setq dm (xdrx_dimension_makerotate 
                 bp1 
                 bp2 
                 (polar bp1 0. (* (distance bp1 bp2) 0.1)) 
                 0.0 
               ) 
      ) 
      (xdrx_pointmonitor "callback" dm) 
      (getpoint "\n位置: ") 
      (xdrx_pointmonitor) 
      (xdrx_entity_setcolor dm 0) 
      (_highlight (cadr an1) (cadr an2) t) 
    ) 
  ) 
  (xdrx_end) 
  (setq        *error*        olderr 
        myerr        nil 
  ) 
  (princ) 
)

Lisphk · 发表于 2014-9-29 12:20:05

{:soso_e142:} 在2005下试了，好强{:soso_e179:}，看下我做的演示。

iLisp · 发表于 2014-9-29 14:30:56

终于看到了！好强！

st788796 · 发表于 2014-9-29 23:39:19

更新，修复亮显未能恢复正常 Bug

明天你好 · 发表于 2014-9-30 02:02:53

不错！St大师辛苦了

elfjack · 发表于 2014-9-30 15:18:56

为什么在选位置的时候取消时，会无限弹错误。

XDSoft · 发表于 2014-9-30 15:26:33

elfjack 发表于 2014-9-30 15:18
为什么在选位置的时候取消时，会无限弹错误。

你加载 XDRX API了吗？

elfjack · 发表于 2014-9-30 15:34:27

XDSoft 发表于 2014-9-30 15:26
你加载 XDRX API了吗？

加载了。一开始还能智能标注，后来在选位置的时候取消就无限弹错误，现在干脆不智能标注了。。。

XDSoft · 发表于 2014-9-30 15:46:04

elfjack 发表于 2014-9-30 15:34
加载了。一开始还能智能标注，后来在选位置的时候取消就无限弹错误，现在干脆不智能标注了。。。

作者程序里面没加错误处理部分，提供的是主要的功能。等作者在完善吧。

st788796 · 发表于 2014-9-30 15:53:05

执行(xdrx_pointmonitor)一次

elfjack · 发表于 2014-9-30 16:01:33

st788796 发表于 2014-9-30 15:53
执行(xdrx_pointmonitor)一次

我执行了好像也没啥用啊。还是不能智能标注。

csharp · 发表于 2014-9-30 16:11:40

elfjack 发表于 2014-9-30 16:01
我执行了好像也没啥用啊。还是不能智能标注。

把 begin 和 end 放到主程序，if 外呢

elfjack · 发表于 2014-9-30 16:51:51

XDSoft 发表于 2014-9-30 15:26
你加载 XDRX API了吗？

貌似我下载的xdrxapi包里只有xdrx_begin 二没有XD：：begin

st788796 · 发表于 2014-9-30 16:53:25

elfjack 发表于 2014-9-30 16:51
貌似我下载的xdrxapi包里只有xdrx_begin 二没有XD：：begin

这个在 xd-lisp-lib.vlx 函数库

elfjack · 发表于 2014-9-30 17:19:22

st788796 发表于 2014-9-30 16:53
这个在 xd-lisp-lib.vlx 函数库

请问你们使用的这种语言骨子里是啥语言？

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

[标注] 智能标注

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

点评

点评

点评

点评

点评

点评