单变双，双变单

luyu9635

想要两个实现如下图功能的程序,图1为双线变单线，选择A，变成B，B的绿线是在红线的中间位置，其中B的红线是不要的，只是为了更好的表达程序的目的；图2为相反的功能，把单线变成双线，其中B的红线同样也是没有的，请大家帮帮忙，谢谢了,另给个附件文件

20060510412

只有演示，没有源代码，真是可惜了

tangjunasd58

这个可以请看附件

luyu9635

这个可能在建筑画图方面用得多

luyu9635

自己顶起,不要沉

longer1000

顶起,不要沉

mmmmmm

单边双是比较简单的，找些单线变双墙的程序就行了。
双变单可参照如下程序
(Defun c:test () (_DrawDivLine (car (entsel)) 0.8))
;;; Format (_DrawDivLine BoundaryRectangleObject[ENAME] GapDistance[REAL]
(Defun _DrawDivLine (pl              gap        /          _GetRectangleCorner
            _Extend2Border        DD          HLINE            II              LL
            SS              UR        VLINE          XMAX            XMAX1     XMIN
            XMIN1     YMAX        YMAX1          YMIN            YMIN1     X1
            X2              Y1        Y2 SN
           )
  (Defun _Extend2Border        (val)
    (cond ((or (equal val xmin 0.01) (equal val ymin 0.01))
           (setq val (- val gap))
          )
          ((or (equal val xmax 0.01) (equal val ymax 0.01))
           (setq val (+ val gap))
          )
    )
    val
  )
  (Defun _GetRectangleCorner (rec / LL UR)
    (vla-getboundingbox (vlax-ename->vla-object rec) 'll 'ur)
    (setq ll (trans (vlax-safearray->list ll) 0 1)
          ur (trans (vlax-safearray->list ur) 0 1)
    )
    (list ll ur)
  )
  (if (setq ss        (_GetRectangleCorner pl)
            gap        (* 0.5 gap)
            ii        -1
            ss        (ssget "_w"
                       (car ss)
                       (cadr ss)
                       '((0 . "*POLYLINE") (8 . "---c01"))
                )
      )
    (repeat (sslength ss)
;;; Hline format Y, XMin, XMax
;;; Vline format X, YMin, YMax
      (setq sn         (ssname ss (setq ii (1+ ii)))
            dd         (_GetRectangleCorner sn)
            ll         (car dd)
            ur         (cadr dd)
            xmin (- (car ll) gap)
            ymin (- (cadr ll) gap)
            xmax (+ (car ur) gap)
            ymax (+ (cadr ur) gap)
      )
      (entdel sn)
      (foreach tmp (list xmin xmax)
        (if (null (setq dd (cdr (assoc tmp vline))))
          (setq vline (cons (list tmp ymin ymax) vline))
          (setq        ymin1 (min ymin (car dd) (cadr dd))
                ymax1 (max ymax (car dd) (cadr dd))
                dd    (list ymin1 ymax1)
                vline (subst (cons tmp dd) (assoc tmp vline) vline)
          )
        )
      )
      (foreach tmp (list ymin ymax)
        (if (null (setq dd (cdr (assoc tmp hline))))
          (setq hline (cons (list tmp xmin xmax) hline))
          (setq        xmin1 (min xmin (car dd) (cadr dd))
                xmax1 (max xmax (car dd) (cadr dd))
                dd    (list xmin1 xmax1)
                hline (subst (cons tmp dd) (assoc tmp hline) hline)
          )
        )
      )
    )
  )
  (setq        hline (vl-sort hline '(lambda (p1 p2) (< (car p1) (car p2))))
        vline (vl-sort vline '(lambda (p1 p2) (< (car p1) (car p2))))
        xmin  (car (car vline))
        xmax  (car (last vline))
        ymin  (car (car hline))
        ymax  (car (last hline))
        hline (cdr hline)
        hline (cdr (reverse hline))
        vline (cdr vline)
        vline (cdr (reverse vline))       
  )  
  (foreach tmp vline
    (setq x1 (_Extend2Border (car tmp))
          y1 (_Extend2Border (cadr tmp))
          y2 (_Extend2Border (nth 2 tmp))
    )
    (entmake (list (cons 0 "line")
                   (cons 8 "---c03")
                   (list 10 x1 y1 0.)
                   (list 11 x1 y2 0.)
             )
    )
  )
  (foreach tmp hline
    (setq y1 (_Extend2Border (car tmp))
          x1 (_Extend2Border (cadr tmp))
          x2 (_Extend2Border (nth 2 tmp))
    )
    (entmake (list (cons 0 "line")
                   (cons 8 "---c03")
                   (list 10 x1 y1 0.)
                   (list 11 x2 y1 0.)
             )
    )
  )
)

smartstar

参考学习。

蒹葭_Keirll

双变单在结构专业也很重要，可以方便PKPM建模

xingyun300

看看这几天有没有帮你，要是没有人帮你，等我有空时给你写一个！近来有点忙！！！！

luyu9635

mmmmmm 发表于 2012-6-30 12:43
单边双是比较简单的，找些单线变双墙的程序就行了。
双变单可参照如下程序
(Defun c:test () (_DrawDivLi ...

谢谢你了，但是加载后出现; 错误: 参数太多，请再实验一下

flytoday

TEST
选择对象: ; 错误: 参数类型错误: lentityp nil