[求助]：求根据梁线自动生成轴线的LISP

kaishuibaihn · 发表于 2005-9-23 16:21:48

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

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

×

1。选择梁线（梁线图层为beam或者beam_con），生成一条对中的轴线（轴线图层为dote），轴线出梁的线长1米。
2。注意如果是连续梁，即被多根梁打断的梁，轴线一定要延伸成下图这样:

xyp1964 · 发表于 2005-10-17 17:54:17

随层的图层线，在图中未注明，不知要加粗哪种线。
梁线生轴线的问题目前未能找到好办法。
信箱已满，无法发短信。

lengliqun · 发表于 2005-10-17 19:00:50

这是个如题目，期待高手来参与。

xyp1964 · 发表于 2005-10-18 01:01:46

尚未完善：

[FONT=courier new](load "xyp_lib")
;|加载通用函数(可在签名栏直接下载)
如果已经下载xyp_lib并放到搜索路径下可以不再下载!
利用以下任何一种方式（首选第一种）即可加载和运行通用函数内的所有子程序：
★1·在acad.lsp中增加(load"xyp_lib")
■2·在每个程序内增加(load"xyp_lib")
■3·在command下，输入(load"xyp_lib")
■4·在菜单.mnl中增加(load"xyp_lib")
■5·将xyp_lib.vlx文件直接拽到cad屏幕
[COLOR=red] ★通用函数下载地址：[/COLOR]
[url]http://www.xdcad.net/forum/attachment.php?s=&postid=1606661[/url]
[url]http://www.mjtd.com/bbs/dispbbs.asp?boardID=3&ID=37554&page=1[/url]|;
(defun c:test ()
(CMDLA0)
(setvar "osmode" 0)
(mkla "AXIS" 1)
(while (setq e1 (entsel "\n选择墙线 : "))
(setq s1 (car e1))
(if (= (dxf 0 (entget s1)) "LINE")
(progn
(setq startpt (dxf 10 (entget S1))
endpt (dxf 11 (entget S1))
a1 (angle startpt endpt)
p1a (_midp startpt endpt)
p1 (osnap (cadr e1) "near")
lyrnm (dxf 8 (entget S1))
)
(setvar "aperture" 50)
(entdel S1)
(setq temp2 (osnap p1 "near"))
(entdel S1)
(setvar "aperture" 4)
(setq s2 (ssname (ssget temp2) 0))
(if
(and
(= (dxf 0 (entget S2)) "LINE")
(/= (dxf 8 (entget S2)) "AXIS")
(or (= (vla-get-angle (vlax-ename->vla-object s2)) a1)
(= (- (vla-get-angle (vlax-ename->vla-object s2)) pi) a1)
(= (+ (vla-get-angle (vlax-ename->vla-object s2)) pi) a1)
)
)
(progn
(setq a2 (angle p1 temp2)
leng (/ (distance p1 temp2) 2.0)
pts-s2 (dxf 10 (entget s2))
pte-s2 (dxf 11 (entget s2))
dist1 (distance startpt endpt)
dist2 (distance pts-s2 pte-s2)
)
(if (> dist1 dist2)
(command "LINE"
(polar startpt a2 leng)
(polar endpt a2 leng)
""
)
(command "LINE"
(polar pts-s2 a2 (* leng -1.0))
(polar pte-s2 a2 (* leng -1.0))
""
)
)
(setq s0 (entlast))
(et-s1 s0)
)
(princ "\n不存在平行线！")
)
)
)
)
(CMDLA1)
)
;;BEAM
(defun et-s1 (ename)
(setq ss (ssget "X" '((0 . "LINE") (8 . "BEAM,AXIS")))
j -1
)
(while (setq s1 (ssname ss (setq j (1+ j))))
(setq pt-int (X_INTERS ename s1 1))
(if pt-int
(progn
(setq pt-int (car pt-int)
pt-s (vlax-curve-getstartpoint ename)
pt-e (vlax-curve-getendpoint ename)
)
(if (< (distance pt-int pt-s)
(distance pt-int pt-e)
)
(command "extend" s1 "" (list ename pt-s) "")
(command "extend" s1 "" (list ename pt-e) "")
)
)
)
)
(setq pt-s (vlax-curve-getstartpoint ename)
pt-e (vlax-curve-getendpoint ename)
rad (angle pt-s pt-e)
pt10 (polar pt-s rad -1500)
pt11 (polar pt-e rad 1500)
)
(sub_upd ename 10 pt10)
(sub_upd ename 11 pt11)
)[/FONT]

[FONT=courier new](load "xyp_lib") 
;|加载通用函数(可在签名栏直接下载) 
如果已经下载xyp_lib并放到搜索路径下可以不再下载! 
利用以下任何一种方式（首选第一种）即可加载和运行通用函数内的所有子程序： 
★1·在acad.lsp中增加(load"xyp_lib") 
■2·在每个程序内增加(load"xyp_lib") 
■3·在command下，输入(load"xyp_lib") 
■4·在菜单.mnl中增加(load"xyp_lib") 
■5·将xyp_lib.vlx文件直接拽到cad屏幕 
[COLOR=red] ★通用函数下载地址：[/COLOR] 
[url]http://www.xdcad.net/forum/attachment.php?s=&postid=1606661[/url] 
[url]http://www.mjtd.com/bbs/dispbbs.asp?boardID=3&ID=37554&page=1[/url]|; 
 
(defun c:test () 
  (CMDLA0) 
  (setvar "osmode" 0) 
  (mkla "AXIS" 1) 
  (while (setq e1 (entsel "\n选择墙线 : ")) 
    (setq s1 (car e1)) 
    (if        (= (dxf 0 (entget s1)) "LINE") 
      (progn 
        (setq startpt (dxf 10 (entget S1)) 
              endpt   (dxf 11 (entget S1)) 
              a1      (angle startpt endpt) 
              p1a     (_midp startpt endpt) 
              p1      (osnap (cadr e1) "near") 
              lyrnm   (dxf 8 (entget S1)) 
        ) 
        (setvar "aperture" 50) 
        (entdel S1) 
        (setq temp2 (osnap p1 "near")) 
        (entdel S1) 
        (setvar "aperture" 4) 
        (setq s2 (ssname (ssget temp2) 0)) 
        (if 
          (and 
            (= (dxf 0 (entget S2)) "LINE") 
            (/= (dxf 8 (entget S2)) "AXIS") 
            (or        (= (vla-get-angle (vlax-ename->vla-object s2)) a1) 
                (= (- (vla-get-angle (vlax-ename->vla-object s2)) pi) a1) 
                (= (+ (vla-get-angle (vlax-ename->vla-object s2)) pi) a1) 
            ) 
          ) 
           (progn 
             (setq a2          (angle p1 temp2) 
                   leng          (/ (distance p1 temp2) 2.0) 
                   pts-s2 (dxf 10 (entget s2)) 
                   pte-s2 (dxf 11 (entget s2)) 
                   dist1  (distance startpt endpt) 
                   dist2  (distance pts-s2 pte-s2) 
             ) 
             (if (> dist1 dist2) 
               (command        "LINE" 
                        (polar startpt a2 leng) 
                        (polar endpt a2 leng) 
                        "" 
               ) 
               (command        "LINE" 
                        (polar pts-s2 a2 (* leng -1.0)) 
                        (polar pte-s2 a2 (* leng -1.0)) 
                        "" 
               ) 
             ) 
             (setq s0 (entlast)) 
             (et-s1 s0) 
           ) 
           (princ "\n不存在平行线！") 
        ) 
      ) 
    ) 
  ) 
  (CMDLA1) 
) 
;;BEAM 
(defun et-s1 (ename) 
  (setq        ss (ssget "X" '((0 . "LINE") (8 . "BEAM,AXIS"))) 
        j  -1 
  ) 
  (while (setq s1 (ssname ss (setq j (1+ j)))) 
    (setq pt-int (X_INTERS ename s1 1)) 
    (if        pt-int 
      (progn 
        (setq pt-int (car pt-int) 
              pt-s   (vlax-curve-getstartpoint ename) 
              pt-e   (vlax-curve-getendpoint ename) 
        ) 
        (if (< (distance pt-int pt-s) 
               (distance pt-int pt-e) 
            ) 
          (command "extend" s1 "" (list ename pt-s) "") 
          (command "extend" s1 "" (list ename pt-e) "") 
        ) 
      ) 
    ) 
  ) 
  (setq        pt-s (vlax-curve-getstartpoint ename) 
        pt-e (vlax-curve-getendpoint ename) 
        rad  (angle pt-s pt-e) 
        pt10 (polar pt-s rad -1500) 
        pt11 (polar pt-e rad 1500) 
  ) 
  (sub_upd ename 10 pt10) 
  (sub_upd ename 11 pt11) 
)[/FONT]

kaishuibaihn · 发表于 2005-10-18 09:13:11

xyp1964兄，使用了一下发现有以下几个问题。
1。平行线的图层是墙线，能不能扩展为只要是同一图层的平行线就能生成轴线，没有图层限制，（且生成的轴线的图层为DOTE，）
2。如下图所示：墙线相交时就不能生成轴线了。
3。如下图所示：墙线生成的轴线是否可以出相交的墙线1000mm.

xyp1964 · 发表于 2005-10-18 10:30:41

5楼：
1、本身就是扩展的，生成的轴线的图层已改为DOTE。
2、可能两线不平行，以后可以加上偏差处理。
3、已改为伸出1000。

[FONT=courier new];;;生成轴线
(defun c:test ()
(CMDLA0)
(setq lts(getvar"ltscale"))
(setvar "osmode" 0)
(setvar"ltscale"1)
(mkla "DOTE" 1)
(JZXX "center" "ACADISO")
(while (setq e1 (entsel "\n选边线 : "))
(setq s1 (car e1))
(if (= (dxf 0 (entget s1)) "LINE")
(progn
(setq startpt (dxf 10 (entget S1))
endpt (dxf 11 (entget S1))
a1 (angle startpt endpt)
p1a (_midp startpt endpt)
p1 (osnap (cadr e1) "near")
lyrnm (dxf 8 (entget S1))
)
(setvar "aperture" 50)
(entdel S1)
(setq temp2 (osnap p1 "near"))
(entdel S1)
(setvar "aperture" 4)
(setq s2 (ssname (ssget temp2) 0))
(if
(and
(= (dxf 0 (entget S2)) "LINE")
(/= (dxf 8 (entget S2)) "DOTE")
(or (= (vla-get-angle (vlax-ename->vla-object s2)) a1)
(= (- (vla-get-angle (vlax-ename->vla-object s2)) pi) a1)
(= (+ (vla-get-angle (vlax-ename->vla-object s2)) pi) a1)
)
)
(progn
(setq a2 (angle p1 temp2)
leng (/ (distance p1 temp2) 2.0)
pts-s2 (dxf 10 (entget s2))
pte-s2 (dxf 11 (entget s2))
dist1 (distance startpt endpt)
dist2 (distance pts-s2 pte-s2)
)
(if (> dist1 dist2)
(command "LINE"
(polar startpt a2 leng)
(polar endpt a2 leng)
""
)
(command "LINE"
(polar pts-s2 a2 (* leng -1.0))
(polar pte-s2 a2 (* leng -1.0))
""
)
)
(setq s0 (entlast))
(et-s1 s0)
)
(princ "\n不存在平行线！")
)
)
)
)
(setvar"ltscale"lts)
(CMDLA1)
)
;;BEAM
(defun et-s1 (ename)
(setq ss (ssget "X" '((0 . "LINE") (8 . "BEAM,DOTE")))
j -1
)
(while (setq s1 (ssname ss (setq j (1+ j))))
(setq pt-int (X_INTERS ename s1 1))
(if pt-int
(progn
(setq pt-int (car pt-int)
pt-s (vlax-curve-getstartpoint ename)
pt-e (vlax-curve-getendpoint ename)
)
(if (< (distance pt-int pt-s)
(distance pt-int pt-e)
)
(command "extend" s1 "" (list ename pt-s) "")
(command "extend" s1 "" (list ename pt-e) "")
)
)
)
)
(setq pt-s (vlax-curve-getstartpoint ename)
pt-e (vlax-curve-getendpoint ename)
rad (angle pt-s pt-e)
pt10 (polar pt-s rad -1000)
pt11 (polar pt-e rad 1000)
)
(sub_upd ename 10 pt10)
(sub_upd ename 11 pt11)
)[/FONT]

[FONT=courier new];;;生成轴线 
(defun c:test () 
  (CMDLA0) 
  (setq lts(getvar"ltscale")) 
  (setvar "osmode" 0) 
  (setvar"ltscale"1) 
  (mkla "DOTE" 1) 
  (JZXX "center" "ACADISO") 
    (while (setq e1 (entsel "\n选边线 : ")) 
    (setq s1 (car e1)) 
    (if        (= (dxf 0 (entget s1)) "LINE") 
      (progn 
        (setq startpt (dxf 10 (entget S1)) 
              endpt   (dxf 11 (entget S1)) 
              a1      (angle startpt endpt) 
              p1a     (_midp startpt endpt) 
              p1      (osnap (cadr e1) "near") 
              lyrnm   (dxf 8 (entget S1)) 
        ) 
        (setvar "aperture" 50) 
        (entdel S1) 
        (setq temp2 (osnap p1 "near")) 
        (entdel S1) 
        (setvar "aperture" 4) 
        (setq s2 (ssname (ssget temp2) 0)) 
        (if 
          (and 
            (= (dxf 0 (entget S2)) "LINE") 
            (/= (dxf 8 (entget S2)) "DOTE") 
            (or        (= (vla-get-angle (vlax-ename->vla-object s2)) a1) 
                (= (- (vla-get-angle (vlax-ename->vla-object s2)) pi) a1) 
                (= (+ (vla-get-angle (vlax-ename->vla-object s2)) pi) a1) 
            ) 
          ) 
           (progn 
             (setq a2          (angle p1 temp2) 
                   leng          (/ (distance p1 temp2) 2.0) 
                   pts-s2 (dxf 10 (entget s2)) 
                   pte-s2 (dxf 11 (entget s2)) 
                   dist1  (distance startpt endpt) 
                   dist2  (distance pts-s2 pte-s2) 
             ) 
             (if (> dist1 dist2) 
               (command        "LINE" 
                        (polar startpt a2 leng) 
                        (polar endpt a2 leng) 
                        "" 
               ) 
               (command        "LINE" 
                        (polar pts-s2 a2 (* leng -1.0)) 
                        (polar pte-s2 a2 (* leng -1.0)) 
                        "" 
               ) 
             ) 
             (setq s0 (entlast)) 
             (et-s1 s0) 
              
           ) 
           (princ "\n不存在平行线！") 
        ) 
      ) 
    ) 
  ) 
  (setvar"ltscale"lts) 
  (CMDLA1) 
) 
;;BEAM 
(defun et-s1 (ename) 
  (setq        ss (ssget "X" '((0 . "LINE") (8 . "BEAM,DOTE"))) 
        j  -1 
  ) 
  (while (setq s1 (ssname ss (setq j (1+ j)))) 
    (setq pt-int (X_INTERS ename s1 1)) 
    (if        pt-int 
      (progn 
        (setq pt-int (car pt-int) 
              pt-s   (vlax-curve-getstartpoint ename) 
              pt-e   (vlax-curve-getendpoint ename) 
        ) 
        (if (< (distance pt-int pt-s) 
               (distance pt-int pt-e) 
            ) 
          (command "extend" s1 "" (list ename pt-s) "") 
          (command "extend" s1 "" (list ename pt-e) "") 
        ) 
      ) 
    ) 
  ) 
  (setq        pt-s (vlax-curve-getstartpoint ename) 
        pt-e (vlax-curve-getendpoint ename) 
        rad  (angle pt-s pt-e) 
        pt10 (polar pt-s rad -1000) 
        pt11 (polar pt-e rad 1000) 
  ) 
  (sub_upd ename 10 pt10) 
  (sub_upd ename 11 pt11) 
)[/FONT]

kaishuibaihn · 发表于 2005-10-18 10:53:39

测试了一下：
1。轴线还是没有出相交线1米长。
2。轴线生成了一段一段的，可否如下图的右图所示（轴线是贯通的）：

xyp1964 · 发表于 2005-10-18 11:14:06

最初由 kaishuibaihn 发布
[B]测试了一下：
1。轴线还是没有出相交线1米长。
2。轴线生成了一段一段的，可否如下图的右图所示（轴线是贯通的）： [/B]

测试无误。
重新下载和加载偶的通用函数！

kaishuibaihn · 发表于 2005-10-18 11:30:18

可是我的是这样的情况呀。有时候平行线找不到，且出线长1000好像不能正确的判断。

kaishuibaihn · 发表于 2005-10-18 11:33:37

这是DWG文件，请xyp1964测试一下。

xyp1964 · 发表于 2005-10-18 12:04:27

边线不能靠得太近！
测试结果：

xyp1964 · 发表于 2005-10-18 13:07:52

编译程序：
简捷命令：HZX

kaishuibaihn · 发表于 2005-10-18 15:08:23

xyp1964 兄
测试了一下再提一点看法：
1。能不能窗选平行线，而不要去点选。
2。能不能增加平行弧线生轴线得功能。
3。边线不能靠的太近，程序是怎么控制的？
4。为什么点击不同的平行线生成得轴线长度不一样，如下图：

xyp1964 · 发表于 2005-10-18 21:02:07

最初由 kaishuibaihn 发布
[B]xyp1964 兄
测试了一下再提一点看法：
1。能不能窗选平行线，而不要去点选。
2。能不能增加平行弧线生轴线得功能。
3。边线不能靠的太近，程序是怎么控制的？
4。为什么点击不同的平行线生成得轴线长度不一样，... [/B]

1、2、都不能
3、三条间距相似的平行线在一起会出错。
4、决定于所选的线长、对面线的线长、轴线两侧延伸是否能产生交点。

eachy · 发表于 2005-10-19 01:38:35

建筑类软件，如天正、理正等好像都有墙生轴线功能，可以窗选。对线排序，当在某一范围内的如370以内的认为是一组墙。

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

[求助]：求根据梁线自动生成轴线的LISP

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

相关帖子