求高手编制大板加腋绘制程序

hdlyt11

现在地下室采用大板加腋的工程越来越多，希望有人能编一个这样的程序，点下内部点，提示偏移四周边线的距离，然后将角点连线，并在图形中心点生成文字标识：加腋板

elitefish

1.设定最小的忽略尺寸A，比如柱子外凸的 200
2.BO 描边 取得PL，并原位复制个PL0
3.炸开PL0，删除长度小于A的线段，将剩余的线组成选择集 SS
4.使用PE命令 模糊距离设置为A 将选择集中重新组成多线段PL1
5.将PL1向点取方向偏移加腋宽度取得PL2
6.将PL1 PL2的对应顶点画上线段L1
7.裁剪 L1 在 PL外的部分
8.删除 PL PL1

hdlyt11

(defun c:bb( / dd pt oo bbo ptlst  l1 l2 l3 l4  ptlst1  p1 p2 p3 p4 oo1 p5 p6 p7 p8)
(vl-load-com)(if (setq  dd(-(getreal"\n必强提示:请输入偏移距离")))(progn(defun bb-asssoc (a lst / b lst2)(while (setq b (assoc a lst))
(setq lst  (cdr (member b lst)) lst2 (cons (cdr b) lst2)))(reverse lst2))(defun bb-entline (b b1)(entmake (list '(0 . "LINE")
(cons 10 b) (cons 11 b1)(cons 8 "楼板加腋")(cons 6 "Continuous"))))(defun bb-offset (a )(vl-catch-all-apply 'vla-offset (list (vlax-ename->vla-object
(ssname bbo a)) dd)))(while(setq pt(getpoint"\n必强提示:指定区域楼板加腋"))(if pt(progn(bpoly pt) (setq oo(entlast))(Setq bbo (ssget "f"
(mapcar 'cdr (vl-remove-if '(lambda (x)(/= 10 (car x)))(entget oo)))'((0 . "LINE")(8 . "BEAM,梁实线,梁虚线"))))(bb-offset 0)(setq l1(entlast))
(bb-offset 1)(setq l2(entlast))(bb-offset 2)(setq l3(entlast))(bb-offset 3)(setq l4(entlast))(setq ptlst(bb-asssoc 10 (entget oo))p1 (nth 1 ptlst)p2
(nth 4 ptlst)p3(nth 7 ptlst)p4(nth 10 ptlst))(bpoly (list(/(+(car p1)(car p3))2.0)(/(+(cadr p1)(cadr p3))2.0)))(setq oo1(entlast)ptlst1(bb-asssoc 10 (entget oo1)))
(vl-cmdf "change" oo1 "" "p""la" "楼板加腋" "lt" "continuous" "" )(setq p5 (nth 0 ptlst1)p6 (nth 1 ptlst1)p7(nth 2 ptlst1)p8(nth 3 ptlst1))
(bb-entline p1 p5)(bb-entline p2 p6)(bb-entline p3 p7)(bb-entline p4 p8)(entdel oo)(entdel l1)(entdel l2)(entdel l3)(entdel l4))))))(princ))

xyccf

;感觉你可能需要自动删除生成的边界，添了一行20180608
;其他的更改留给懂行的人吧^_^;建议你以后提问的时候要详细描述清楚自己的需求，除了动图示意还要有测试图，不要让论坛里的人做无用功
(vl-load-com)
(defun MAT:vxs ( v s )
  (mapcar (function (lambda ( n ) (* n s))) v)
)
(defun GEO:Centroid (Pts / )
  (MAT:vxs (apply 'mapcar (cons '+ pts)) (/ 1.0 (length pts)))
)
(defun PtLists (en)
  (mapcar 'cdr
          (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget en))
  )
);xyccf 20180606 支持偏移距离和字高的记忆功能
(defun c:tt(/ pt ent1 ent2 ptlst1 ptlst2 )
  (setq pt (getpoint))
  (setq dis (getreal "输入偏移距离"))
  (if dis (setq dis_old dis) (setq dis dis_old))
  (setq zg1 (getreal "输入字高"))
  (if zg1 (setq zg1 zg1_old) (setq zg1_old zg1))
  (bpoly pt)
  (setq ent1 (entlast))
  (vla-offset (vlax-ename->vla-object ent1) (* -1 dis))
  (setq ent2 (entlast))
  (setq ptlst1 (PtLists ent1)
        ptlst2 (PtLists ent2))
  (foreach x ptlst1
    (setq pt1 x)
    (setq pt2 (car (vl-sort ptlst2 '(lambda (a b) (< (distance a x) (distance b x))))))
    (entmake (list '(0 . "LINE") (cons 10 pt1) (cons 11 pt2)))
    (entmake (list '(0 . "TEXT") (cons 1 "加腋板") (cons 10 (GEO:Centroid ptlst2))  (cons 40 zg1)))
  )   (entsel ent1)
  (princ)
)

自贡黄明儒

这个容易，关键中间那个矩形与外框的关系。

hdlyt11

xyccf 发表于 2018-6-6 14:47
(vl-load-com)
(defun MAT:vxs ( v s )
  (mapcar (function (lambda ( n ) (* n s))) v)

非常感谢，测试结果是这样的，还不够完美

w245272914

+1   经测试，程序是不够完美。

evayleung

这功能好，希望有高手完善它

longer1000

这功能好，希望完善它

crtrccrt

把无关的图层关闭。
例图中，应把”柱子”图层关闭，保留”梁“图层，试试。或隐藏”柱子”实体，加肋后再显示”柱子“实体。

hdlyt11

crtrccrt 发表于 2018-6-7 20:09
把无关的图层关闭。
例图中，应把”柱子”图层关闭，保留”梁“图层，试试。或隐藏”柱子”实体，加肋后再 ...

也是不可以的

hdlyt11

此程序淘宝网上售价2元，只是付了款，卖家根本不发货