求将多段线转化成交通标线的程序！

spp_wall

由于一些特殊要求，需要写一个转化的程序，程序要求如下图或见dwg，

newer

spp_wall 发表于 2016-12-10 22:03

要批量就这样

(defun c:tt ()
  (if (and
        (setq swid (getreal "\n落笔段长度<退出>:"))
        (setq ewid (getreal "\n抬笔段长度<退出>:"))
        (setq wid (getreal "\n输入线宽<退出>:"))
      )
    (while (and        (xdrx_initssget "\n选择曲线<退出>:")
                (setq ss (xdrx_ssget
                           '((0 . "LINE,*POLYLINE,ARC"))
                         )
                )
           )
      (mapcar
        '(lambda (e)
           (setq len1 (xdrx_getpropertyvalue e "length")
                 len  0.0
                 pts  nil
           )
           (while
             (setq p1 (xdrx_curve_getpointatdist e (+ len swid)))
              (setq pts (cons p1 pts))
              (setq len (+ len swid ewid))
              (if (setq p2 (xdrx_curve_getpointatdist e len))
                (setq pts (cons p2 pts))
              )
           )
           (setq pts (reverse pts))
           (setq ss (apply
                      'xdrx_curve_getsplitcurves
                      (cons e pts)
                    )
           )
           (setq i 0)
           (setq ents (xdrx_pickset->ents ss))
           (xdrx_entity_delete
             (XD::List:odd (xd::list:removetail ents))
           )
           (mapcar
             '(lambda (x)
                (setq g         (xdge::constructor x)
                      g1 (xdge::constructor "kcompositecrv3d")
                )
                (xdge::setpropertyvalue g1 "setcurvelist" g)
                (xdge::entity:make g1)
                (xdrx_entity_setpropertiesfrom (entlast) x)
                (xdrx_setpropertyvalue (entlast) "constantwidth" wid)
                (xdrx_entity_delete x)
                (xdge::free g g1)
              )
             ents
           )
         )
        (xdrx_pickset->ents ss)
      )
    )
  )
  (princ)
)

Lisphk

用线型就能实现吧？

革天明

你应该想要的代码是Lisp的吧？我用的是arx，arx的需要编译才能使用，目前只是初步实现，有需要请留言

spp_wall

Lisphk 发表于 2016-12-6 21:08

线型是可以实现  但是想导入到其他程序  其他程序不认线型！！！

newer

spp_wall 发表于 2016-12-6 21:53

那就是硬打断了。

spp_wall

newer 发表于 2016-12-6 23:29

恩  不过好像用多段线或者把多段线做成块 做列阵好像就可以了！  

列阵要选基点啥的 有时基点指定不对  还不能框选

直接打断应该会快点吧

newer

试试

(defun c:tt ()
  (if (and
        (setq swid (getreal "\n落笔段长度<退出>:"))
        (setq ewid (getreal "\n抬笔段长度<退出>:"))
        (setq wid (getreal "\n输入线宽<退出>:"))
        (setq e (car (xdrx_entsel "\n点取曲线<退出>" '((0 . "LINE,*POLYLINE,ARC")))))
      )
    (progn
      (setq len1 (xdrx_getpropertyvalue e "length")
            len 0.0
            pts nil
      )
      (while (setq p1 (xdrx_curve_getpointatdist e (+ len swid)))
        (setq pts (cons p1 pts))
        (setq len (+ len swid ewid))
        (if (setq p2 (xdrx_curve_getpointatdist e len))
          (setq pts (cons p2 pts))
        )
      )
      (setq pts (reverse pts))
      (setq ss (apply
                 'xdrx_curve_getsplitcurves
                 (cons e pts)
               )
      )
      (setq i 0)
      (setq ents (xdrx_pickset->ents ss))
      (xdrx_entity_delete (XD::List:odd (xd::list:removetail ents)))
      (mapcar
        '(lambda (x)
           (setq g (xdge::constructor x)
                 g1 (xdge::constructor "kcompositecrv3d")
           )
           (xdge::setpropertyvalue g1 "setcurvelist" g)
           (xdge::entity:make g1)
           (xdrx_entity_setpropertiesfrom (entlast) x)
           (xdrx_setpropertyvalue (entlast) "constantwidth" wid)
           (xdrx_entity_delete x)
           (xdge::free g g1)
         )
        ents
      )
    )
  )
  (princ)
)

spp_wall

newer 发表于 2016-12-9 22:58

不知道能否框选呢！！！

spp_wall

newer 发表于 2016-12-6 19:43

好像最近无法使用了 不知道什么原因！！！！
输入完数据 就没反应了！

XDSoft

spp_wall 发表于 2017-8-7 15:49

刚用了下，能用，下载最新的API和晓东工具箱。

spp_wall

XDSoft 发表于 2017-8-7 16:02

在家里能用 在单位不行 奇怪了

newer

spp_wall 发表于 2017-8-8 19:33

API版本不一样？

spp_wall

newer 发表于 2017-8-8 20:10

家里的是旧的 好像没装晓东工具箱  


http://bbs.xdcad.net/forum.php?m ... hlight=%C2%D6%C0%AA

这个可以 找到了！

spp_wall

newer 发表于 2017-8-8 20:10

发现一个问题  这个程序生成多段线的时候 会在原点生成多段线！！！