[编程申请]：结构专业中，由模板自动生成配筋图

coolzhb · 发表于 2003-8-11 11:25:49

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

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

×

程序我已经写好了一部分，可以实现附图的上面功能，
选中外框线，在其内部生成一段一段的pline，现在需要
直接一步达到下图的功能，请xd和各位朋友帮忙改一下
程序，谢谢！

具体的要求为：

如果两pline线夹角大于180，则将pline沿交点延长一个长度，
人工输入如200，这是结构上配筋的构造要求，再在每个pline线
的内侧居中画3个钢筋剖面点（间距定200），长度小于400的
pline线不要画点钢筋了。

[FONT=courier new]
(defun c:ctjc (/ ss box base outline n wid pt dist e dist1)
(setq tscale (getvar "dimscale"))
(prompt "\n请选取剖面<退出>:")
(if (setq ss (ssget '((0 . "solid,*line,ellipse,arc,circle,insert"))))
(progn
(xdrx_begin '("cmdecho" 0
"highlight" 1
)
)
(xdrx_ucson)
(xdrx_drawing_viewsave)
(setq outline (xdrx_searchoutline ss))
(foreach n outline
(apply
'xdrx_grdraw
(append
(list 1 1)
n
)
)
)
(xdrx_setmark)
(setq wid (* tscale 0.45))
(xdrx_searchoutline ss wid)
(princ)
(setq dist1 (getreal "\n 输入距离：<1>"))
(if (= dist1 nil) (setq dist1 -1) (setq dist (* -1 dist1)))
(setq dist (* dist1 tscale))
(prompt "\n请选取要偏移的实体<退出>:")
(setq ss (ssget '((0 . "*line,arc,circle,ellipse"))))
;(setq ss (entget (entlast)))
(xdrx_setsstodb ss 0)
(while (setq e (xdrx_getentdata 0))
(setq pts (xdrx_curve_offset e dist))
(command "_.offset" (abs dist) e (car pts) "")
)
(command "_.erase" "p" "")
)
)
(prompt "\n请选取钢筋:")
(if (setq ss (ssget '((0 . "solid,*line,ellipse,arc,circle,insert"))))
(progn
(setq outline (xdrx_searchoutline ss))
(foreach n outline
(apply
'xdrx_grdraw
(append
(list 1 1)
n
)
)
)
(xdrx_setmark)
(xdrx_searchoutline ss nil)
(command "_.erase" "p" "")
(while (cdr pts)
(command ".pline" (car pts) "w" (* 0.45 TSCALE) (* 0.45 TSCALE) (cadr pts) "")
(setq pts (cdr pts))
)
(xdrx_drawing_viewres)
(xdrx_ucsoff)
(xdrx_end)
)
)
(princ)
)
[/FONT]

[FONT=courier new] 
(defun c:ctjc (/ ss box base outline n wid pt dist e dist1) 
  (setq tscale (getvar "dimscale")) 
  (prompt "\n请选取剖面<退出>:") 
  (if (setq ss (ssget '((0 . "solid,*line,ellipse,arc,circle,insert")))) 
    (progn 
      (xdrx_begin '("cmdecho" 0 
                   "highlight" 1 
                  ) 
      ) 
      (xdrx_ucson) 
      (xdrx_drawing_viewsave) 
      (setq outline (xdrx_searchoutline ss)) 
      (foreach n outline 
        (apply 
          'xdrx_grdraw 
          (append 
            (list 1 1) 
            n 
          ) 
        ) 
      ) 
      (xdrx_setmark) 
      (setq wid (* tscale 0.45)) 
      (xdrx_searchoutline ss wid) 
      (princ) 
      (setq dist1 (getreal "\n 输入距离：<1>")) 
      (if (= dist1 nil) (setq dist1 -1) (setq dist (* -1 dist1))) 
      (setq dist (* dist1 tscale)) 
      (prompt "\n请选取要偏移的实体<退出>:") 
      (setq ss (ssget '((0 . "*line,arc,circle,ellipse")))) 
      ;(setq ss (entget (entlast))) 
      (xdrx_setsstodb ss 0) 
      (while (setq e (xdrx_getentdata 0)) 
        (setq pts (xdrx_curve_offset e dist)) 
        (command "_.offset" (abs dist) e (car pts) "") 
      ) 
      (command "_.erase" "p" "") 
    ) 
  ) 
 
 
  (prompt "\n请选取钢筋:") 
  (if (setq ss (ssget '((0 . "solid,*line,ellipse,arc,circle,insert")))) 
    (progn 
      (setq outline (xdrx_searchoutline ss)) 
      (foreach n outline 
        (apply 
          'xdrx_grdraw 
          (append 
            (list 1 1) 
            n 
          ) 
        ) 
      ) 
      (xdrx_setmark) 
      (xdrx_searchoutline ss nil) 
      (command "_.erase" "p" "") 
      (while (cdr pts) 
        (command ".pline" (car pts) "w" (* 0.45 TSCALE) (* 0.45 TSCALE) (cadr pts) "") 
        (setq pts (cdr pts)) 
      ) 
      (xdrx_drawing_viewres) 
      (xdrx_ucsoff) 
      (xdrx_end) 
    ) 
  ) 
  (princ) 
) 
 
  [/FONT]

aeo · 发表于 2003-9-16 21:18:06

来啦:

;pl线变单段
;都为直线
(defun pl->every-pl (ss / j ss1 pl->every)
(command"convert""p""s" ss "")
(defun pl->every (e1 / a cl e li wid)
(setq e (entget e1)
cl (cdr (assoc 70 e))
wid (assoc 43 e)
)
(foreach x e(if (= 10 (car x))(setq li (cons x li))))
(setq li (reverse li))
(if (= cl 0)
(setq a (car li) li (cdr li))
(setq a (last li))
)
(while (setq b (car li))
(entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '
(100 . "AcDbPolyline") '(90 . 2) '(70 . 0) wid a b
)
)
(ssadd (entlast) ss1)
(setq a b li (cdr li)
)
)
(entdel e1)
)
(setq ss1 (ssadd)j 0
)
(repeat (sslength ss)
(pl->every (ssname ss j))
(setq j (1+ j))
)
ss1
)
(defun c:ttt( / ang dis dis0 e0 e1 e2 j li-po p1 p2 p3 p4 p5 p6 pt ss)
(setq e0(entlast) j 0)
(xdrx_begin '("cmdecho" 0 "blipmode" 0 "osmode" 0 "plinetype" 2))
(if(and
(setq pt(getpoint"\n在里面点一下:"))
(setq ss(ssget "c"(car(xdrx_getscreenbox))(caddr(xdrx_getscreenbox))'((0 . "*POLYLINE"))))
(progn(command"-boundary""a""o""p""b""n" ss """"pt"")
(setq e1(entlast))
(not(equal e0 e1))
)
(setq li-po(xdrx_getsamplept e1))
(entdel e1)
(setq ss(ssget "f" li-po '((0 . "*POLYLINE"))))
(setq ss(pl->every-pl ss))
(progn(setq dis(getdist"\n现在中断为连续的pl线打断.输入出头距离(200):"))
(if(not dis)(setq dis 200) t)
)
)
(repeat(sslength ss)
(setq e2(ssname ss j)
p1(xdrx_polyline_getPointAt e2 0)
p2(xdrx_polyline_getPointAt e2 1)
ang(angle p1 p2)
dis0(distance p1 p2)
)
(setq p3(polar p2 ang dis))
(if(apply 'xdrx_isinside(cons(mapcar '+ p3 '(0.9 0.3 0))li-po)) ;p3要偏移一点是因为xdrx_isinside的bug
(progn(xdrx_polyline_setPointAt e2 1 p3)(setq p2 p3))
)
(setq p3(polar p1 (+ pi ang) dis))
(if(apply 'xdrx_isinside(cons(mapcar '+ p3 '(0.9 0.3 0))li-po))
(progn (xdrx_polyline_setPointAt e2 0 p3)(setq p1 p3))
)
(setq p3(xdrx_midp p1 p2)
p4(polar p3(+ ang(/ pi 2.)) 90)
p5(polar p3(- ang(/ pi 2.)) 90)
p6(if(apply 'xdrx_isinside(cons p4 li-po))p4 p5)
)
(if(> dis0 400)
(command"donut""0""80"p6(polar p6 ang 200)(polar p6(+ ang pi)200)"")
)
(setq j(1+ j))
)
)
(xdrx_end)
(princ)
)

;pl线变单段 
;都为直线 
(defun pl->every-pl (ss / j ss1 pl->every) 
  (command"convert""p""s" ss "") 
  (defun pl->every (e1 / a cl e li wid) 
    (setq e (entget e1) 
          cl (cdr (assoc 70 e)) 
          wid (assoc 43 e) 
    ) 
    (foreach x e(if (= 10 (car x))(setq li (cons x li)))) 
    (setq li (reverse li)) 
    (if (= cl 0) 
      (setq a (car li) li (cdr li)) 
      (setq a (last li)) 
    ) 
    (while (setq b (car li)) 
      (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") ' 
                     (100 . "AcDbPolyline") '(90 . 2) '(70 . 0) wid a b 
               ) 
      ) 
      (ssadd (entlast) ss1) 
      (setq a b li (cdr li) 
      ) 
    ) 
    (entdel e1) 
  ) 
  (setq ss1 (ssadd)j 0 
  ) 
  (repeat (sslength ss) 
    (pl->every (ssname ss j)) 
    (setq j (1+ j)) 
  ) 
  ss1 
) 
 
 
 
 
(defun c:ttt( / ang dis dis0 e0 e1 e2 j li-po p1 p2 p3 p4 p5 p6 pt ss) 
 (setq e0(entlast) j 0) 
 (xdrx_begin '("cmdecho" 0 "blipmode" 0 "osmode" 0 "plinetype" 2)) 
 (if(and 
     (setq pt(getpoint"\n在里面点一下:")) 
     (setq ss(ssget "c"(car(xdrx_getscreenbox))(caddr(xdrx_getscreenbox))'((0 . "*POLYLINE")))) 
     (progn(command"-boundary""a""o""p""b""n" ss """"pt"") 
           (setq e1(entlast)) 
           (not(equal e0 e1)) 
      ) 
     (setq li-po(xdrx_getsamplept e1)) 
     (entdel e1) 
     (setq ss(ssget "f" li-po '((0 . "*POLYLINE")))) 
     (setq ss(pl->every-pl ss)) 
     (progn(setq dis(getdist"\n现在中断为连续的pl线打断.输入出头距离(200):")) 
         (if(not dis)(setq dis 200) t) 
     ) 
    ) 
 (repeat(sslength ss) 
   (setq e2(ssname ss j) 
         p1(xdrx_polyline_getPointAt e2 0) 
         p2(xdrx_polyline_getPointAt e2 1) 
         ang(angle p1 p2) 
         dis0(distance p1 p2) 
   ) 
   (setq p3(polar p2 ang dis)) 
   (if(apply 'xdrx_isinside(cons(mapcar '+ p3 '(0.9 0.3 0))li-po))  ;p3要偏移一点是因为xdrx_isinside的bug 
      (progn(xdrx_polyline_setPointAt e2 1 p3)(setq p2 p3)) 
   ) 
   (setq p3(polar p1 (+ pi ang) dis)) 
   (if(apply 'xdrx_isinside(cons(mapcar '+ p3 '(0.9 0.3 0))li-po)) 
      (progn (xdrx_polyline_setPointAt e2 0 p3)(setq p1 p3)) 
   ) 
   (setq p3(xdrx_midp p1 p2) 
         p4(polar p3(+ ang(/ pi 2.)) 90) 
         p5(polar p3(- ang(/ pi 2.)) 90) 
         p6(if(apply 'xdrx_isinside(cons p4 li-po))p4 p5) 
     ) 
   (if(> dis0 400) 
    (command"donut""0""80"p6(polar p6 ang 200)(polar p6(+ ang pi)200)"") 
   ) 
   (setq j(1+ j)) 
  ) 
 ) 
(xdrx_end) 
(princ) 
)

有问题说!
原始的线可以连续,也可以断开

coolzhb · 发表于 2003-9-17 08:29:44

最初由 aeo 发布
[B]来啦:
[code]
;pl线变单段
;都为直线
(defun pl->every-pl (ss / j ss1 pl->every)
  (command"convert""p""s" ss "")
  (defun pl->every (e1 / a cl e li wid)
(setq e (entget e1)
   cl (cdr (asso... [/B]

aeo 版主，程序基本可以达到我的要求，但是能不能改进以下，我的要求是有了外框线（pline，如果能判断line线更好），在内部点一下，就向内部偏移一个长度，生成配筋图。另外程序有时候判断好像会出错，能不能看看我的附件的图！

coolzhb · 发表于 2003-9-17 08:31:00

上面的图看不清除，贴dwg的图吧！再次感谢aeo！

aeo · 发表于 2003-9-18 00:20:40

改了改,反而短了

(defun pl->every (e1 / a cl e li ss1 )
(command"convert""p""s" e1 "")
(setq ss1(ssadd)
e (entget e1)
cl (cdr (assoc 70 e))
)
(foreach x e(if (= 10 (car x))(setq li (cons x li))))
(setq li (reverse li))
(if (= cl 0)
(setq a (car li) li (cdr li))
(setq a (last li))
)
(while (setq b (car li))
(entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity")
'(100 . "AcDbPolyline") '(90 . 2)
'(70 . 0)'(43 . 60) a b ;加粗到60可以否?
)
)
(ssadd (entlast) ss1)
(setq a b li (cdr li)
)
)
(entdel e1)
ss1
)
(defun c:ttt( / ang dis dis0 e0 e1 e2 j li-po p1 p2 p3 p4 p5 p6 pt ss)
(setq e0(entlast) j 0)
(xdrx_begin '("cmdecho" 0 "blipmode" 0 "osmode" 0 "plinetype" 2))
(if(and
(setq pt(getpoint"\n在里面点一下:"))
(progn
(command"-boundary""a""o""p"""pt"")
(setq e1(entlast))
(not(equal e0 e1))
)
(vla-offset(vlax-ename->vla-object e1)-120) ;不知道是不是永远对，测试一下.还有120可以否?
(setq li-po(xdrx_getsamplept (entlast)))
(entdel e1)
(setq ss(pl->every (entlast)))
(progn(setq dis(getdist"\n现在中断为连续的pl线打断.输入出头距离(200):"))
(if(not dis)(setq dis 200) t)
)
)
(repeat(sslength ss)
(setq e2(ssname ss j)
p1(xdrx_polyline_getPointAt e2 0)
p2(xdrx_polyline_getPointAt e2 1)
ang(angle p1 p2)
dis0(distance p1 p2)
)
(setq p3(polar p2 ang dis))
(if(apply 'xdrx_isinside(cons(mapcar '+ p3 '(0.9 0.3 0))li-po)) ;p3要偏移一点是因为xdrx_isinside的bug
(progn(xdrx_polyline_setPointAt e2 1 p3)(setq p2 p3))
)
(setq p3(polar p1 (+ pi ang) dis))
(if(apply 'xdrx_isinside(cons(mapcar '+ p3 '(0.9 0.3 0))li-po))
(progn (xdrx_polyline_setPointAt e2 0 p3)(setq p1 p3))
)
(setq p3(xdrx_midp p1 p2)
p4(polar p3(+ ang(/ pi 2.)) 90)
p5(polar p3(- ang(/ pi 2.)) 90)
p6(if(apply 'xdrx_isinside(cons p4 li-po))p4 p5)
)
(if(> dis0 400)
(command"donut""0""80"p6(polar p6 ang 200)(polar p6(+ ang pi)200)"")
)
(setq j(1+ j))
)
)
(xdrx_end)
(princ)
)

(defun pl->every (e1 / a cl e li ss1 ) 
   (command"convert""p""s" e1 "") 
    (setq ss1(ssadd) 
          e (entget e1) 
          cl (cdr (assoc 70 e)) 
    ) 
    (foreach x e(if (= 10 (car x))(setq li (cons x li)))) 
    (setq li (reverse li)) 
    (if (= cl 0) 
      (setq a (car li) li (cdr li)) 
      (setq a (last li)) 
    ) 
    (while (setq b (car li)) 
      (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") 
                     '(100 . "AcDbPolyline") '(90 . 2) 
                     '(70 . 0)'(43 . 60) a b     ;加粗到60可以否? 
               ) 
      ) 
      (ssadd (entlast) ss1) 
      (setq a b li (cdr li) 
      ) 
    ) 
    (entdel e1) 
    ss1 
  ) 
 
 
(defun c:ttt( / ang dis dis0 e0 e1 e2 j li-po p1 p2 p3 p4 p5 p6 pt ss) 
 (setq e0(entlast) j 0) 
 (xdrx_begin '("cmdecho" 0 "blipmode" 0 "osmode" 0 "plinetype" 2)) 
 (if(and 
     (setq pt(getpoint"\n在里面点一下:")) 
     (progn 
           (command"-boundary""a""o""p"""pt"") 
           (setq e1(entlast)) 
           (not(equal e0 e1)) 
      ) 
     (vla-offset(vlax-ename->vla-object e1)-120)  ;不知道是不是永远对，测试一下.还有120可以否? 
     (setq li-po(xdrx_getsamplept (entlast))) 
     (entdel e1) 
     (setq ss(pl->every (entlast))) 
     (progn(setq dis(getdist"\n现在中断为连续的pl线打断.输入出头距离(200):")) 
         (if(not dis)(setq dis 200) t) 
     ) 
    ) 
 (repeat(sslength ss) 
   (setq e2(ssname ss j) 
         p1(xdrx_polyline_getPointAt e2 0) 
         p2(xdrx_polyline_getPointAt e2 1) 
         ang(angle p1 p2) 
         dis0(distance p1 p2) 
   ) 
   (setq p3(polar p2 ang dis)) 
   (if(apply 'xdrx_isinside(cons(mapcar '+ p3 '(0.9 0.3 0))li-po))  ;p3要偏移一点是因为xdrx_isinside的bug 
      (progn(xdrx_polyline_setPointAt e2 1 p3)(setq p2 p3)) 
   ) 
   (setq p3(polar p1 (+ pi ang) dis)) 
   (if(apply 'xdrx_isinside(cons(mapcar '+ p3 '(0.9 0.3 0))li-po)) 
      (progn (xdrx_polyline_setPointAt e2 0 p3)(setq p1 p3)) 
   ) 
   (setq p3(xdrx_midp p1 p2) 
         p4(polar p3(+ ang(/ pi 2.)) 90) 
         p5(polar p3(- ang(/ pi 2.)) 90) 
         p6(if(apply 'xdrx_isinside(cons p4 li-po))p4 p5) 
     ) 
   (if(> dis0 400) 
    (command"donut""0""80"p6(polar p6 ang 200)(polar p6(+ ang pi)200)"") 
   ) 
   (setq j(1+ j)) 
  ) 
 ) 
(xdrx_end) 
(princ) 
)

prestress · 发表于 2003-9-18 00:41:12

很不错，我试试看！

coolzhb · 发表于 2003-9-18 08:15:53

最初由 aeo 发布
[B]改了改,反而短了
[code]
(defun pl->every (e1 / a cl e li ss1 )
(command"convert""p""s" e1 "")
(setq ss1(ssadd)
e (entget e1)
cl (cdr (assoc 70 e))
)
(foreach x e(if ... [/B]

aeo，谢谢，程序在1：100的比例下完全达到我的要求！说说它的效果吧，我们同事在画设备基础图（超级复杂），模板图做好了，让小姑娘画了两天的钢筋才画了一半，用此程序2分钟搞定了基本图，然后修改了2小时搞定了，同事说她今天不用加班也能轻松画好图！呵呵！

能把这句
(vla-offset(vlax-ename->vla-object e1)-120)
改为在R14下也好用那就更好了（xd的api好像有类似的功能），我们设计院一般在R14内画呢！

还有增加比例的变量，如myscale
与比例有关的地方有以下几个方面：
（1）
(entmake list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline")
'(90 . 2) '(70 . 0) '(43 . 45) a b)) 中的45（原来为60）改为myscale×0.45

（2）
(vla-offset (vlax-ename->vla-object e1) -120)
中-120改为-1.2×myscale

（3）
p4 (polar p3 (+ ang (/ pi 2.)) 90)
p5 (polar p3 (- ang (/ pi 2.)) 90)
中90改为0.9×myscale

（4）
(command "donut" "0" "60" p6 (polar p6 ang 200) (polar p6 (+ ang pi 200) "")
中60改为0.6×myscale

subtlation · 发表于 2003-11-25 20:15:30

怎么用？下载了载入cad，输入TTT后显示
命令: ttt
; 错误: no function definition: XDRX_BEGIN

coolzhb · 发表于 2003-11-26 08:18:05

最初由 subtlation 发布
[B]怎么用？下载了载入cad，输入TTT后显示
命令: ttt
; 错误: no function definition: XDRX_BEGIN [/B]

需要xdapi支持，在cad2002中使用!

subtlation · 发表于 2003-11-26 10:53:12

CAD2004简体中文版中不行吗？期待升级中。。。。。。

coolzhb · 发表于 2003-11-27 07:30:26

最初由 subtlation 发布
[B]CAD2004简体中文版中不行吗？期待升级中。。。。。。 [/B]

xdapi不支持cad2004，所以2004不支持！

aeo · 发表于 2004-1-15 01:48:46

;;;改比例用 tzbl吧,没时间放到里面,抱歉.

(defun c:tzbl()(setq MYscale(getint "\n比例1: ")))
(defun c:ttt( / ang dis dis0 e0 e1 e2 j li-po p1 p2 p3 p4 p5 p6 pt ss)
(if (not MYscale)(or(setq MYscale(getint "\n比例1:(100) "))(setq MYscale 100)))
(setq e0(entlast) j 0)
(xdrx_begin '("cmdecho" 0 "blipmode" 0 "osmode" 0 "plinetype" 2))
(if(and
(setq pt(getpoint"\n在里面点一下:"))
(progn
(command"-boundary""a""o""p"""pt"")
(setq e1(entlast))
(not(equal e0 e1))
)
(setvar "offsetdist"(* 1.2 myscale))
(progn(command".offset""" e1 pt "") t)
(setq li-po(xdrx_getsamplept (entlast)))
(entdel e1)
(setq ss(pl->every (entlast)))
(progn(setq dis(getdist"\n现在中断为连续的pl线打断.输入出头距离(200):"))
(if(not dis)(setq dis 200) t)
)
)
(repeat(sslength ss)
(setq e2(ssname ss j)
p1(xdrx_polyline_getPointAt e2 0)
p2(xdrx_polyline_getPointAt e2 1)
ang(angle p1 p2)
dis0(distance p1 p2)
)
(setq p3(polar p2 ang dis))
(if(apply 'xdrx_isinside(cons(mapcar '+ p3 '(0.9 0.3 0))li-po)) ;p3要偏移一点是因为xdrx_isinside的bug
(progn(xdrx_polyline_setPointAt e2 1 p3)(setq p2 p3))
)
(setq p3(polar p1 (+ pi ang) dis))
(if(apply 'xdrx_isinside(cons(mapcar '+ p3 '(0.9 0.3 0))li-po))
(progn (xdrx_polyline_setPointAt e2 0 p3)(setq p1 p3))
)
(setq p3(xdrx_midp p1 p2)
p4(polar p3(+ ang(/ pi 2.))(* myscale 0.9))
p5(polar p3(- ang(/ pi 2.))(* myscale 0.9))
p6(if(apply 'xdrx_isinside(cons p4 li-po))p4 p5)
)
(if(> dis0 400)
(command"donut""0"(* myscale 0.6) p6(polar p6 ang 200)(polar p6(+ ang pi)200)"")
)
(setq j(1+ j))
)
)
(xdrx_end)
(princ)
)
(defun pl->every (e1 / a cl e li ss1 )
(command"convert""p""s" e1 "")
(setq ss1(ssadd)
e (entget e1)
cl (cdr (assoc 70 e))
)
(foreach x e(if (= 10 (car x))(setq li (cons x li))))
(setq li (reverse li))
(if (= cl 0)
(setq a (car li) li (cdr li))
(setq a (last li))
)
(while (setq b (car li))
(entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity")
'(100 . "AcDbPolyline") '(90 . 2)
'(70 . 0)(cons 43 (* 0.45 myscale)) a b ;;;
)
)
(ssadd (entlast) ss1)
(setq a b li (cdr li)
)
)
(entdel e1)
ss1
)

(defun c:tzbl()(setq MYscale(getint "\n比例1: "))) 
 
(defun c:ttt( / ang dis dis0 e0 e1 e2 j li-po p1 p2 p3 p4 p5 p6 pt ss) 
 (if (not MYscale)(or(setq MYscale(getint "\n比例1:(100) "))(setq MYscale 100))) 
 (setq e0(entlast) j 0) 
 (xdrx_begin '("cmdecho" 0 "blipmode" 0 "osmode" 0 "plinetype" 2)) 
 (if(and 
     (setq pt(getpoint"\n在里面点一下:")) 
     (progn 
           (command"-boundary""a""o""p"""pt"") 
           (setq e1(entlast)) 
           (not(equal e0 e1)) 
      ) 
     (setvar "offsetdist"(* 1.2 myscale)) 
     (progn(command".offset""" e1 pt "") t) 
     (setq li-po(xdrx_getsamplept (entlast))) 
     (entdel e1) 
     (setq ss(pl->every (entlast))) 
     (progn(setq dis(getdist"\n现在中断为连续的pl线打断.输入出头距离(200):")) 
         (if(not dis)(setq dis 200) t) 
     ) 
    ) 
 (repeat(sslength ss) 
   (setq e2(ssname ss j) 
         p1(xdrx_polyline_getPointAt e2 0) 
         p2(xdrx_polyline_getPointAt e2 1) 
         ang(angle p1 p2) 
         dis0(distance p1 p2) 
   ) 
   (setq p3(polar p2 ang dis)) 
   (if(apply 'xdrx_isinside(cons(mapcar '+ p3 '(0.9 0.3 0))li-po))  ;p3要偏移一点是因为xdrx_isinside的bug 
      (progn(xdrx_polyline_setPointAt e2 1 p3)(setq p2 p3)) 
   ) 
   (setq p3(polar p1 (+ pi ang) dis)) 
   (if(apply 'xdrx_isinside(cons(mapcar '+ p3 '(0.9 0.3 0))li-po)) 
      (progn (xdrx_polyline_setPointAt e2 0 p3)(setq p1 p3)) 
   ) 
   (setq p3(xdrx_midp p1 p2) 
         p4(polar p3(+ ang(/ pi 2.))(* myscale 0.9)) 
         p5(polar p3(- ang(/ pi 2.))(* myscale 0.9)) 
         p6(if(apply 'xdrx_isinside(cons p4 li-po))p4 p5) 
     ) 
   (if(> dis0 400) 
    (command"donut""0"(* myscale 0.6) p6(polar p6 ang 200)(polar p6(+ ang pi)200)"") 
   ) 
   (setq j(1+ j)) 
  ) 
 ) 
(xdrx_end) 
(princ) 
) 
 
 
(defun pl->every (e1 / a cl e li ss1 ) 
   (command"convert""p""s" e1 "") 
    (setq ss1(ssadd) 
          e (entget e1) 
          cl (cdr (assoc 70 e)) 
    ) 
    (foreach x e(if (= 10 (car x))(setq li (cons x li)))) 
    (setq li (reverse li)) 
    (if (= cl 0) 
      (setq a (car li) li (cdr li)) 
      (setq a (last li)) 
    ) 
    (while (setq b (car li)) 
      (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") 
                     '(100 . "AcDbPolyline") '(90 . 2) 
                     '(70 . 0)(cons 43 (* 0.45 myscale)) a b    ;;; 
               ) 
      ) 
      (ssadd (entlast) ss1) 
      (setq a b li (cdr li) 
      ) 
    ) 
    (entdel e1) 
    ss1 
  )

后面有个出头200,要改 (* myscale ...)自己算吧.

coolzhb · 发表于 2004-1-15 10:56:39

最初由 aeo 发布
[B];;;改比例用 tzbl吧,没时间放到里面,抱歉.
[code]
(defun c:tzbl()(setq MYscale(getint "\n比例1: ")))

(defun c:ttt( / ang dis dis0 e0 e1 e2 j li-po p1 p2 p3 p4 p5 p6 pt ss)
(if (not MYscale)(or(set... [/B]

aeo就是aeo，修改程序快又好！
支持aeo！谢谢aeo！

alwaysbin · 发表于 2004-5-31 20:57:11

需要xdapi支持，在cad2002中使用，但是我们现在画图还在用R14啊，
能不能开发个用于14的，几位高手，能不能弄个通俗一点的版本，期待中……

eachy · 发表于 2004-6-1 07:30:23

最初由 alwaysbin 发布
[B]需要xdapi支持，在cad2002中使用，但是我们现在画图还在用R14啊，
能不能开发个用于14的，几位高手，能不能弄个通俗一点的版本，期待中…… [/B]

在14下加载API然后加载程序也许可以运行。

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

[编程申请]：结构专业中，由模板自动生成配筋图

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

相关帖子

浏览过的版块