动态拖曳的可视化多义线offset

snoopychen · 发表于 2006-10-1 08:19:10

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

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

×

由于对探索者中某些动态功能比较感兴趣，确不懂怎么实现
最近在theswamp向evgeniy请教了一个动态显示的问题，帖子在
http://www.theswamp.org/index.php?topic=12692.0
evgeniy在递归、多义线及动态显示方面很厉害。
在他的教导下，写出如下的一段多义线的动态显示程序，请指正。
有不少容错及控制的代码没有写上。

[pcode=lisp,true]
;; Great thanks to Evgeniy at www.theswamp.org             ;
;; Without his help, I dont know how the dynamic effect    ;
;; The following code take many from Evgeniy's code       ;
;; write by CHEN QING JUN, http://autolisper.googlepages.com;
(defun c:test1 (/ en en1 e ent1 gr d pt_res)
  (prompt "\n please select a polyline")
  (setq en (car (entsel)))
  (command "copy" en "" '(0. 0. 0.) '(0. 0. 0.))
  (setq en1 (entlast)
      e (reverse (vl-member-if
                     (function (lambda (x)
                                 (= (car x) 39)
                              ) ;_  lambda
                     ) ;_  function
                     (reverse (entget en1))
                  ) ;_  vl-member-if
         )
  )
  (setq ent1 (entget en))
  (while (= (car (setq gr (grread nil 5 0))) 5)
(setq d (distance (cadr gr)
                  (vlax-curve-getClosestPointTo
                     en
                     (cadr gr)
                  ) ;_  vlax-curve-getClosestPointTo
         ) ;_  distance

)
(setq pt_res (myoffset en (cadr gr) d))
(entmod_pline e pt_res)
)
)

;;;;offset new lwpolyline and get the vertex          ;
(defun myoffset (ename pt dist / newent new res1)
  (command "offset" dist ename pt "")
  (setq new (entlast))
  (setq newent (entget new))
  (setq res1 (w_pl_lst newent))
  (entdel new)
  res1
)

;;;;entmod new polyline by vertex and bulge list    ;
(defun entmod_pline (e lst)
  (entmod (append
         e
         lst
      )
  )
)

;;;;get the vertex and bulge list of a polyline    ;
(defun w_pl_lst (ent / pt_list bulge_list x i res)
  (foreach x ent
(if (= (car x) 10)
   (setq pt_list (append
                  (list (cdr x))
                  pt_list
                  )
   )
)
(if (= (car x) 42)
   (setq bulge_list (append
                     (list (cdr x))
                     bulge_list
                     )
   )
)
  )
  (setq pt_list (reverse pt_list))
  (setq bulge_list (reverse bulge_list))
  (setq i 0)
  (repeat (length pt_list)
(setq res (append
            res
            (list (cons 10 (nth i pt_list)))
            (list (cons 42 (nth i bulge_list)))
            )
)
(setq i (1+ i))
  )
  res
)
[/pcode]

eachy · 发表于 2006-10-1 09:31:24

从完善角度讲，有的Pline Offset 后会断成几段

露水2 · 发表于 2006-10-1 09:59:29

CHEN QING JUN
楼主的英语真厉害
先说说你的英语怎么学的吧？

qjcpj · 发表于 2006-10-1 20:55:37

很有创意，学习一下。

雨箭风刀 · 发表于 2006-10-2 09:31:23

动态容易做，要支持输入确定值不容易。。。

eachy · 发表于 2006-10-3 09:19:31

最初由雨箭风刀发布
[B]动态容易做，要支持输入确定值不容易。。。 [/B]

不是没有可能，Grread 返回 2 的时候是键盘的 ASCII，用 vl-list->string 就可以取得字符，当一直用键盘输入时可以构造一个List，该List 只保存符合输入规则的字符，当然要进行一系列的判断测试。
简单的写了一个
[iframe h=600 w=100%]http://eachy.bokee.com/5720143.html[/iframe]

雨箭风刀 · 发表于 2006-10-4 23:06:46

抽空测试了一下,snoopychen 的程序,对pline效果不错,对arc,circle异常,对spline有错误(可能是offset出来的实体不止是一个的原因)

fsxm · 发表于 2006-10-5 19:48:37

呵呵~我也来玩动态的~不是用entmod是删除后再生成的
用vla-Offset的支持所有曲线!可以输入精确偏移值.

(defun c:testofst (/ dist dist? en
exitwhile grr grr1 grr2
key offset *ERROR* deloffset
trimlast curve-point-inorout
)
(setq en (vlax-ename->vla-object (car (entsel))))
(defun *ERROR* (msg)
(deloffset)
(princ msg)
(princ "=====>安全退出!........")
)
(defun deloffset ()
(if offset
(foreach item offset (vla-Delete item))
)
)
(defun trimlast (str)
(substr str 1 (1- (strlen str)))
)
(defun curve-point-inorout (en pt / 2pi enname fun prj v)
(setq enname (vla-get-objectname en))
(setq 2pi (* 2 pi))
(setq prj (vlax-curve-getClosestPointTo en pt))
(setq v (vlax-curve-getFirstDeriv
en
(vlax-curve-getParamAtPoint en prj)
)
)
(if (or (= enname "AcDbLine") (= enname "AcDbXline"))
(setq fun <)
(setq fun >)
)
(fun (rem (+ 2pi
(- (angle prj pt)
(angle '(0 0 0) v)
)
)
2pi
)
pi
)
)
(if (not offseltxt)
(setq offseltxt "")
)
(while (not exitwhile)
(setq grr (grread t)
grr1 (car grr)
grr2 (cadr grr)
)
(princ (strcat "\r当前输入值为：" offseltxt))
(cond
((= grr1 2) ;grr1=2
(setq key (chr grr2))
(cond ((and
(<= grr2 57) ;num
(>= grr2 46)
(/= grr2 47)
(/= (type (read (strcat offseltxt key))) 'SYM)
)
(setq offseltxt (strcat offseltxt key))
(princ (strcat "\r当前输入值为：" offseltxt))
)
((= grr2 8)
(setq offseltxt (trimlast offseltxt))
(princ "\r ")
(princ (strcat "\r当前输入值为：" offseltxt))
)
((or (= grr2 13) (= grr2 32)) ;space or enter
(deloffset)
(setq dist (atof offseltxt))
(vla-Offset en (* dist dist?))
(setq exitwhile t)
)
)
) ;grr1=2end
((= grr1 5) ;muose move
(setq dist
(distance (vlax-curve-getclosestpointto en grr2 t) grr2)
)
(if (not (equal dist 1e-4))
(progn
(deloffset)
(setq dist? (if (curve-point-inorout en grr2)
1
-1
)
)
(setq
offset (vlax-safearray->list
(vlax-variant-value
(vla-Offset en (* dist dist?))
)
)
)
)
)
)
((= grr1 3) ;left
(setq exitwhile t)
)
(t ;exit
(deloffset)
(setq exitwhile t)
)
)
)
(princ)
)

(defun c:testofst (/               dist           dist?       en 
                   exitwhile   grr           grr1               grr2 
                   key               offset           *ERROR*     deloffset 
                   trimlast    curve-point-inorout 
                  ) 
  (setq en (vlax-ename->vla-object (car (entsel)))) 
  (defun *ERROR* (msg) 
    (deloffset) 
    (princ msg) 
    (princ "=====>安全退出!........") 
  ) 
  (defun deloffset () 
    (if        offset 
      (foreach item offset (vla-Delete item)) 
    ) 
  ) 
  (defun trimlast (str) 
    (substr str 1 (1- (strlen str))) 
  ) 
  (defun curve-point-inorout (en pt / 2pi enname fun prj v) 
    (setq enname (vla-get-objectname en)) 
    (setq 2pi (* 2 pi)) 
    (setq prj (vlax-curve-getClosestPointTo en pt)) 
    (setq v (vlax-curve-getFirstDeriv 
              en 
              (vlax-curve-getParamAtPoint en prj) 
            ) 
    ) 
    (if        (or (= enname "AcDbLine") (= enname "AcDbXline")) 
      (setq fun <) 
      (setq fun >) 
    ) 
    (fun (rem (+ 2pi 
                 (- (angle prj pt) 
                    (angle '(0 0 0) v) 
                 ) 
              ) 
              2pi 
         ) 
         pi 
    ) 
  ) 
  (if (not offseltxt) 
    (setq offseltxt "") 
  ) 
  (while (not exitwhile) 
    (setq grr  (grread t) 
          grr1 (car grr) 
          grr2 (cadr grr) 
    ) 
    (princ (strcat "\r当前输入值为：" offseltxt)) 
    (cond 
      ((= grr1 2)                        ;grr1=2 
       (setq key (chr grr2)) 
       (cond ((and 
                (<= grr2 57)                ;num 
                (>= grr2 46) 
                (/= grr2 47) 
                (/= (type (read (strcat offseltxt key))) 'SYM) 
              ) 
              (setq offseltxt (strcat offseltxt key)) 
              (princ (strcat "\r当前输入值为：" offseltxt)) 
             ) 
             ((= grr2 8) 
              (setq offseltxt (trimlast offseltxt)) 
              (princ "\r                                       ") 
              (princ (strcat "\r当前输入值为：" offseltxt)) 
             ) 
             ((or (= grr2 13) (= grr2 32)) ;space or enter 
              (deloffset) 
              (setq dist (atof offseltxt)) 
              (vla-Offset en (* dist dist?)) 
              (setq exitwhile t) 
             ) 
       ) 
      )                                        ;grr1=2end 
      ((= grr1 5)                        ;muose move 
       (setq dist 
              (distance (vlax-curve-getclosestpointto en grr2 t) grr2) 
       ) 
       (if (not (equal dist 1e-4)) 
         (progn 
           (deloffset) 
           (setq dist? (if (curve-point-inorout en grr2) 
                         1 
                         -1 
                       ) 
           ) 
           (setq 
             offset (vlax-safearray->list 
                      (vlax-variant-value 
                        (vla-Offset en (* dist dist?)) 
                      ) 
                    ) 
           ) 
         ) 
       ) 
      ) 
      ((= grr1 3)                        ;left 
       (setq exitwhile t) 
      ) 
      (t                                ;exit 
       (deloffset) 
       (setq exitwhile t) 
      ) 
    ) 
  ) 
  (princ) 
)

snoopychen · 发表于 2006-10-5 22:10:22

谢谢各位，初次研究动态的东西，引来了这么多的玉，感谢：）
fsxm的程序非常好
我从中学到了
1）curve-point-inorout这个判断offset方向的函数
原来也想用vla-offset函数的，不清楚怎么判断方向才用了command-offset，现在学了一招
2）改变我原来的思路，当时时间比较急，因此一直沿着evgeniy的entmod思路走了下来，导致只能动态改变多线，出去的这几天还在想着对其他类型的线也编些entmod，现在看来是走了弯路了。

谢谢eachy版主和fsxm关于同时对键盘及鼠标进行监控的cond函数

to 露水2
其实我的英语水平很一般，但是只要问问题的时候把大概的意思表达清楚，高手们都挺乐意帮助我们的

to 刀兄和eachy版主：）
原来的程序确实只是考虑多义线的，对于offset出多段多义线的确实没有考虑在内。

在fsxm的思路指引下，把原来一楼的改成如下代码，可以支持多种曲线，但是不支持键盘输入的，效率应该不如fsxm的高:p
不大懂怎么在14下用类似vlax-curve-getClosestPointTo的函数，不然的话，倒是可以在14下试试

;;test for dynamic offset
;; by QJCHEN
;;采用fsxm的思路
(defun c:test1 (/ en en1 e ent1 gr d pt_res tempent)
(prompt "\n please select a polyline")
(setq en (car (entsel)))
(while (= (car (setq gr (grread nil 5 0))) 5)
(setq d (distance (cadr gr)
(vlax-curve-getClosestPointTo
en
(cadr gr)
) ;_ vlax-curve-getClosestPointTo
) ;_ distance
)
(myoffset en (cadr gr) d)
;(entmod_pline e pt_res)
)
)
;;;;offset new lwpolyline and get the vertex ;
(defun myoffset (ename pt dist / newent new res1)
(command "erase" tempent "")
(command "offset" dist ename pt "")
(setq new (entlast))
(setq newent (entget new))
(entdel new)
(command "offset" dist ename pt "")
(setq tempent (entlast))
)

;;test for dynamic offset 
;; by QJCHEN 
;;采用fsxm的思路 
(defun c:test1 (/ en en1 e ent1 gr d pt_res tempent) 
  (prompt "\n please select a polyline") 
  (setq en (car (entsel))) 
  (while (= (car (setq gr (grread nil 5 0))) 5) 
    (setq d (distance (cadr gr) 
                      (vlax-curve-getClosestPointTo 
                        en 
                        (cadr gr) 
                      ) ;_  vlax-curve-getClosestPointTo 
            ) ;_  distance 
 
    ) 
    (myoffset en (cadr gr) d) 
    ;(entmod_pline e pt_res) 
    ) 
) 
 
;;;;offset new lwpolyline and get the vertex           ; 
(defun myoffset (ename pt dist / newent new res1) 
  (command "erase" tempent "") 
  (command "offset" dist ename pt "") 
  (setq new (entlast)) 
  (setq newent (entget new)) 
  (entdel new) 
  (command "offset" dist ename pt "") 
  (setq tempent (entlast)) 
)

fsxm · 发表于 2006-10-6 21:20:31

最近想了一下关于grread捕捉的问题~以下用到了grread捕捉自定义函数grreadosnap请于
http://www.xdcad.net/forum/showt ... 还不理想~呵呵
请各们多多指教啊~

(defun c:test (/ dist dist? en
exitwhile grr grr1 grr2
key offset offset1 *error*
deloffset trimlast curve-point-inorout
)
(vl-load-com)
(setq en (vlax-ename->vla-object (car (entsel))))
(defun *error* (msg)
(deloffset)
(princ msg)
(princ "=====>安全退出!........")
)
(defun deloffset ()
(cond (offset
(foreach item offset (vla-delete item))
(setq offset nil)
)
)
)
(defun trimlast (str)
(substr str 1 (1- (strlen str)))
)
(defun curve-point-inorout (en pt / 2pi enname fun prj v)
(setq enname (vla-get-objectname en))
(setq 2pi (* 2 pi))
(setq prj (vlax-curve-getclosestpointto en pt))
(setq v (vlax-curve-getfirstderiv
en
(vlax-curve-getparamatpoint en prj)
)
)
(if (or (= enname "AcDbLine") (= enname "AcDbXline"))
(setq fun <)
(setq fun >)
)
(fun (rem (+ 2pi
(- (angle prj pt)
(angle '(0 0 0) v)
)
)
2pi
)
pi
)
)
(if (not offseltxt)
(setq offseltxt "")
)
(while (not exitwhile)
(setq grr (grread t)
grr1 (car grr)
grr2 (cadr grr)
)
(princ (strcat "\r当前输入值为：" offseltxt))
(cond
((= grr1 2) ;grr1=2
(setq key (chr grr2))
(cond ((and
(<= grr2 57) ;num
(>= grr2 46)
(/= grr2 47)
(/= (type (read (strcat offseltxt key))) 'sym)
)
(setq offseltxt (strcat offseltxt key))
(princ (strcat "\r当前输入值为：" offseltxt))
)
((= grr2 8)
(setq offseltxt (trimlast offseltxt))
(princ "\r ")
(princ (strcat "\r当前输入值为：" offseltxt))
)
((or (= grr2 13) (= grr2 32)) ;space or enter
(deloffset)
(setq dist (atof offseltxt))
(if (vl-catch-all-error-p
(vl-catch-all-apply
'vla-offset
(list en (* dist dist?))
)
)
(progn
(princ "\r输入超过允许！")
(setq offseltxt "")
(princ "\n")
)
(setq exitwhile t)
)
)
((= grr2 6)
(command "_+dsettings" 2)
)
)
) ;grr1=2end
((= grr1 5) ;muose move
(setq grr2 (grreadosnap grr2)) ;如果不用捕捉请删除这行
(setq dist
(distance (vlax-curve-getclosestpointto en grr2 t) grr2)
)
(if (not (equal dist 1e-4))
(progn
(deloffset)
(setq dist? (if (curve-point-inorout en grr2)
1
-1
)
)
(setq offset1 (vl-catch-all-apply
'vla-offset
(list en (* dist dist?))
)
)
(if (not (vl-catch-all-error-p offset1))
(setq
offset (vlax-safearray->list
(vlax-variant-value
offset1
)
)
)
)
)
)
)
((= grr1 3) ;left
(setq exitwhile t)
)
(t ;exit
(deloffset)
(setq exitwhile t)
)
)
)
(princ)
)

(defun c:test (/           dist               dist?           en 
               exitwhile   grr               grr1           grr2 
               key           offset      offset1           *error* 
               deloffset   trimlast    curve-point-inorout 
              ) 
  (vl-load-com) 
  (setq en (vlax-ename->vla-object (car (entsel)))) 
  (defun *error* (msg) 
    (deloffset) 
    (princ msg) 
    (princ "=====>安全退出!........") 
  ) 
  (defun deloffset () 
    (cond (offset 
           (foreach item offset (vla-delete item)) 
           (setq offset nil) 
          ) 
    ) 
  ) 
  (defun trimlast (str) 
    (substr str 1 (1- (strlen str))) 
  ) 
  (defun curve-point-inorout (en pt / 2pi enname fun prj v) 
    (setq enname (vla-get-objectname en)) 
    (setq 2pi (* 2 pi)) 
    (setq prj (vlax-curve-getclosestpointto en pt)) 
    (setq v (vlax-curve-getfirstderiv 
              en 
              (vlax-curve-getparamatpoint en prj) 
            ) 
    ) 
    (if        (or (= enname "AcDbLine") (= enname "AcDbXline")) 
      (setq fun <) 
      (setq fun >) 
    ) 
    (fun (rem (+ 2pi 
                 (- (angle prj pt) 
                    (angle '(0 0 0) v) 
                 ) 
              ) 
              2pi 
         ) 
         pi 
    ) 
  ) 
  (if (not offseltxt) 
    (setq offseltxt "") 
  ) 
  (while (not exitwhile) 
    (setq grr  (grread t) 
          grr1 (car grr) 
          grr2 (cadr grr) 
    ) 
    (princ (strcat "\r当前输入值为：" offseltxt)) 
    (cond 
      ((= grr1 2)                        ;grr1=2 
       (setq key (chr grr2)) 
       (cond ((and 
                (<= grr2 57)                ;num 
                (>= grr2 46) 
                (/= grr2 47) 
                (/= (type (read (strcat offseltxt key))) 'sym) 
              ) 
              (setq offseltxt (strcat offseltxt key)) 
              (princ (strcat "\r当前输入值为：" offseltxt)) 
             ) 
             ((= grr2 8) 
              (setq offseltxt (trimlast offseltxt)) 
              (princ "\r                                       ") 
              (princ (strcat "\r当前输入值为：" offseltxt)) 
             ) 
             ((or (= grr2 13) (= grr2 32)) ;space or enter 
              (deloffset) 
              (setq dist (atof offseltxt)) 
              (if (vl-catch-all-error-p 
                    (vl-catch-all-apply 
                      'vla-offset 
                      (list en (* dist dist?)) 
                    ) 
                  ) 
                (progn 
                  (princ "\r输入超过允许！") 
                  (setq offseltxt "") 
                  (princ "\n") 
                ) 
                (setq exitwhile t) 
              ) 
             ) 
             ((= grr2 6) 
              (command "_+dsettings" 2) 
             ) 
       ) 
      )                                ;grr1=2end 
      ((= grr1 5)                        ;muose move 
       (setq grr2 (grreadosnap grr2))        ;如果不用捕捉请删除这行 
       (setq dist 
              (distance (vlax-curve-getclosestpointto en grr2 t) grr2) 
       ) 
       (if (not (equal dist 1e-4)) 
         (progn 
           (deloffset) 
           (setq dist? (if (curve-point-inorout en grr2) 
                         1 
                         -1 
                       ) 
           ) 
           (setq offset1 (vl-catch-all-apply 
                           'vla-offset 
                           (list en (* dist dist?)) 
                         ) 
           ) 
           (if (not (vl-catch-all-error-p offset1)) 
             (setq 
               offset (vlax-safearray->list 
                        (vlax-variant-value 
                          offset1 
                        ) 
                      ) 
             ) 
           ) 
         ) 
       ) 
      ) 
      ((= grr1 3)                        ;left 
       (setq exitwhile t) 
      ) 
      (t                                ;exit 
       (deloffset) 
       (setq exitwhile t) 
      ) 
    ) 
  ) 
  (princ) 
)

jx2008 · 发表于 2006-11-20 13:02:10

谢谢。多多学习学习

taner · 发表于 2008-12-5 13:44:08

grread一直不会用,郁闷!哪位大虾抽空讲解一下?

carrot1983 · 发表于 2008-12-5 17:05:59

占个位子学习。。。grread最近有一小点心得。
说白了就是获取了设备的响应

露水2 · 发表于 2008-12-6 11:11:26

grread 如鸡肋

露水2 · 发表于 2008-12-6 11:13:53

再来

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

[原创] 动态拖曳的可视化多义线offset

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

本帖被以下淘专辑推荐:

相关帖子