明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 3372|回复: 18

求高手帮忙,批量生成中线

  [复制链接]
发表于 2013-1-9 10:12 | 显示全部楼层 |阅读模式
1明经币
小弟初学lisp,会只找出两条线中线的办法,求高手帮忙搞定批量生成程序,感激不尽。
以下是生成中线的部分代码和测试图


  1. (defun c:tt()
  2. (setq ssL (ssget '((0 . "LINE"))))
  3. ;;下面取出两条线的坐标
  4. ;;;此处加入判断是否选择了两根梁线
  5. ;;;下面取得两条梁线的四个端点
  6. (if (= (sslength SSL) 2)
  7.      (progn
  8. (setq pt1 (cdr (assoc 10 (entget (ssname ssL 0))))
  9.        pt2 (cdr (assoc 11 (entget (ssname ssL 0))))
  10.        pt3 (cdr (assoc 10 (entget (ssname ssL 1))))
  11.        pt4 (cdr (assoc 11 (entget (ssname ssL 1))))
  12.        ang1 (/ (* (vla-get-angle(vlax-ename->vla-object(ssname ssL 0))) 180) pi)  ;;;直线1的角度
  13.        ang2 (/ (* (vla-get-angle(vlax-ename->vla-object(ssname ssL 1))) 180) pi)  ;;;直线2的角度

  14. )
  15.        )
  16.   ;;;增加错误函数
  17. );end if
  18. ;;;m1,m2为两条直线中心线的两端点
  19. (setq m1 (list (/ (+ (car pt1) (car pt3)) 2) (/ (+ (cadr pt1) (cadr pt3)) 2)))  
  20. (setq m2 (list (/ (+ (car pt2) (car pt4)) 2) (/ (+ (cadr pt2) (cadr pt4)) 2)))
  21.     (if (and
  22.       (= (rtos (car m1) 2 4) (rtos (car m2) 2 4))
  23.       (= (rtos (cadr m1) 2 4) (rtos (cadr m2) 2 4))
  24.       (= (rtos (last m1) 2 4) (rtos (last m2) 2 4))
  25.     )
  26.     (progn
  27.       (setq pt10 pt1)
  28.       (setq pt1 pt2)
  29.       (setq pt2 pt10)
  30.       (setq m1 (list (/ (+ (car pt1) (car pt3)) 2) (/ (+ (cadr pt1) (cadr pt3)) 2)))
  31.       (setq m2 (list (/ (+ (car pt2) (car pt4)) 2) (/ (+ (cadr pt2) (cadr pt4)) 2)))
  32.       )  
  33.     )
  34.   )





附件: 您需要 登录 才可以下载或查看,没有账号?注册
发表于 2013-1-9 10:12 | 显示全部楼层

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x

点评

这个程序只能对直线有用,还可以完善一下,对多段线也适用就更好了!  发表于 2013-1-12 11:46
要的就是这效果 不过你多要了我一个币,哈哈  发表于 2013-1-9 13:29
回复

使用道具 举报

发表于 2013-1-9 10:15 | 显示全部楼层
同求,为楼主顶一下

点评

多谢捧场  发表于 2013-1-9 10:52
回复

使用道具 举报

发表于 2013-1-9 11:04 | 显示全部楼层
测试图太片面,最好是从工作底图上截下的,未说明规则,太笼统,不好办.

点评

谢谢关注!中线不是我最终要实现的目的,实际工作图也是这样的,平行线几乎在同一直线上  发表于 2013-1-9 11:16
回复

使用道具 举报

发表于 2013-1-9 11:15 | 显示全部楼层
看帖就回,顶起来让高手出招  偷学  
回复

使用道具 举报

发表于 2013-1-9 11:43 | 显示全部楼层
中心线的好像就可以
回复

使用道具 举报

发表于 2013-1-9 11:47 | 显示全部楼层
回复

使用道具 举报

发表于 2013-1-9 12:31 | 显示全部楼层
可以换个思路,画出中心线,用双向偏移,得到平行线.这样可以多选.
回复

使用道具 举报

发表于 2013-1-9 14:48 | 显示全部楼层
本帖最后由 004 于 2013-1-9 14:50 编辑

  1. (defun c:tt (/           2PI         3/4PI A     ANG   B         BANG  BEND  BST
  2.              END   LST         MID   PI/2  SS           SSMID SSPT1 SSPT2 ST
  3.             )
  4.   ;;添加直线中心线   2013-01-09   
  5.   (setvar "osmode" 0)
  6.   (setq pi/2 (/ pi 2))
  7.   (setq 2pi (* 2 pi))
  8.   (setq 3/4pi (/ (* 3 pi) 4))
  9.   (defun sjzl (e / ANG EL END ST TMP)
  10.     (setq el (entget e))
  11.     (setq st (cdr (assoc 10 el)))
  12.     (setq st (list (car st) (cadr st)))
  13.     (setq end (cdr (assoc 11 el)))
  14.     (setq end (list (car end) (cadr end)))
  15.     (setq ang (angle st end))
  16.     (cond ((or (= ang 0) (= ang pi) (= ang 2pi))
  17.            (progn (setq ang 0)
  18.                   (if (> (car st) (car end))
  19.                     (setq tmp st
  20.                           st  end
  21.                           end tmp
  22.                     )
  23.                   )
  24.            )
  25.           )
  26.           ((or (= ang pi/2) (= ang 3/4pi))
  27.            (progn (setq ang pi/2)
  28.                   (if (> (cadr st) (cadr end))
  29.                     (setq tmp st
  30.                           st  end
  31.                           end tmp
  32.                     )
  33.                   )
  34.            )
  35.           )
  36.           ((> ang pi)
  37.            (progn (setq        ang (- ang pi)
  38.                         tmp st
  39.                         st  end
  40.                         end tmp
  41.                   )
  42.            )
  43.           )
  44.     )
  45.     (list st end ang)
  46.   )
  47.   (setq ss (ssget "x" '((0 . "LINE") (8 . "BEAM"))))
  48.   (while (> (sslength ss) 0)
  49.     (setq a (ssname ss 0))
  50.     (setq lst (sjzl a))
  51.     (setq st (car lst))
  52.     (setq end (cadr lst))
  53.     (setq ang (caddr lst))
  54.     (setq mid (mapcar (function (lambda (a b) (/ (+ a b) 2))) st end))
  55.     (setq sspt1 (polar mid (+ ang (/ pi 2)) 400)) ;选取长度
  56.     (setq sspt2 (polar mid (- ang (/ pi 2)) 400))
  57. ;;;    (command "pline" sspt1 sspt2 "")
  58.     (command ".zoom" "w" sspt1 sspt2)
  59.     (setq ssmid
  60.            (ssget "f" (list sspt1 sspt2) '((0 . "LINE") (8 . "BEAM")))
  61.     )
  62.     (if        (= (sslength ssmid) 2)
  63.       (progn
  64.         (ssdel a ssmid)
  65.         (ssdel a ss)
  66.         (setq b (ssname ssmid 0))
  67.         (setq lst (sjzl b))
  68.         (setq bst (car lst))
  69.         (setq bend (cadr lst))
  70.         (setq bang (caddr lst))
  71.         (if (equal ang bang 0.01)
  72.           (progn
  73.             (ssdel b ss)
  74.             (setq st
  75.                    (mapcar (function (lambda (a b) (/ (+ a b) 2))) st bst)
  76.             )
  77.             (setq end (mapcar (function (lambda (a b) (/ (+ a b) 2)))
  78.                               end
  79.                               bend
  80.                       )
  81.             )
  82.             (entmake (list '(0 . "LINE") (cons 10 st) (cons 11 end)))
  83.           )
  84.         )
  85.       )
  86.       (ssdel a ss)
  87.     )
  88.   )
  89.   (princ)
  90. )
回复

使用道具 举报

发表于 2013-1-9 15:04 | 显示全部楼层

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-3-29 15:23 , Processed in 0.229394 second(s), 31 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表