设为首页收藏本站CAD论坛CAD教程CAD下载明经币充值
切换到宽版

明经CAD社区

 找回密码
 注册

QQ登录

只需一步，快速开始

搜索
明经CAD社区»社区 › 开发篇 › AutoLISP/Visual LISP 编程技术 › ★★批量直线、矩形、圆中心线，唯独圆不行，请大侠指点
返回列表 发新帖
查看: 2291|回复: 7

[提问] ★★批量直线、矩形、圆中心线，唯独圆不行，请大侠指点

[复制链接]
wanhongron
发表于 2016-8-23 18:02:32 | 显示全部楼层 |阅读模式
工作中经常用到批量直线、矩形、圆中心线，唯独圆不行，程序是在网上收集的，请大侠指点。
中心线

本帖子中包含更多资源

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

x

相关帖子
回复

使用道具 举报

xxxyyyzzz
发表于 2016-8-23 21:29:42 | 显示全部楼层
没有看程序，圆的中心线一大堆，总得规定一个什么东西，我猜少这个。
回复 支持 反对

使用道具 举报

edata
发表于 2016-8-23 22:14:45 | 显示全部楼层
  1. ;;;△△△批量中心线
  2. (defun C:ZZZZ (/     en    en_data         lx     pt0
  3.       nx     cenpt  r   pt3x  pt3y pt4x   pt4y   pt5
  4.       pt5x   pt5y   pt6   pt6x  pt6y l      l1     en3
  5.       en1    en1_data   en2  en2_data)
  6.   (terpri)
  7.   (setq v1 (getvar "osmode"))
  8.   (setq v2 (getvar "cmdecho"))
  9.   (setq v3 (getvar "blipmode"))
  10.   (setvar "cmdecho" 0)
  11.   (setvar "blipmode" 0)
  12.   (SETVAR "OSMODE" 0)
  13.   (graphscr)
  14.   (setq SS (ssget '((0 . "CIRCLE,LINE,*POLYLINE"))));批量选择
  15.   (setq N 0)
  16.   (repeat (sslength SS);循环开始
  17.   (setq en (ssname ss N))
  18.   (setq en_data (entget en))
  19.   (setq lx_list (assoc 0 en_data))
  20.   (setq lx (cdr lx_list))
  21.   (cond ((= "CIRCLE" lx)
  22.   (progn
  23.     (setq v4 (getvar "CLAYER"))
  24.     ;(setq pt0 (cadr en))
  25.     (setq nx (cdr (assoc 0 en_data)))
  26.     ;(setq cenpt (osnap pt0 "center"))
  27.     (setq cenpt (cdr (assoc 10 en_data)))
  28.     (setq r (cdr (assoc 40 en_data)))
  29.     (setq pt1 (polar cenpt pi (+ (* r 0.2) r)))
  30.     (setq pt2 (polar cenpt 0 (+ (* r 0.2) r)))
  31.     (setq pt3 (polar cenpt (* 0.5 pi) (+ (* r 0.2) r)))
  32.     (setq pt4 (polar cenpt (* 1.5 pi) (+ (* r 0.2) r)))
  33.     (command "osnap" "none")
  34.     (if (not (tblsearch "LAYER" "Cen"))
  35.       (command "layer" "m" "Cen" "c" 1 "" "l" "center2" "" "lw"
  36.         0.18 "" "")
  37.     )
  38.     (command "layer" "s" "cen" "")
  39.     (command "line" pt1 pt2 "")
  40.     (command "line" pt3 pt4 "")
  41.     (setvar "CLAYER" v4)
  42.   )
  43. )
  44. ((= "LINE" lx)
  45.   (progn
  46.     (SETVAR "OSMODE" 0)
  47.     (command "ucs" "w" )
  48.     (setq v4 (getvar "CLAYER"))
  49.     (setq ent (entget en))
  50.     (setq Pt1 (cdr (assoc 10 ent)))
  51.     (setq Pt2 (cdr (assoc 11 ent)))
  52.     (setq l (distance Pt1 Pt2))
  53.     (setq al (angle Pt1 Pt2))
  54.     (setq Pt3 (polar Pt1 al (/ l 2)))
  55.     (setq Pt4 (polar Pt3 (+ al (* pi 1.5)) (/ l 2)))
  56.     (setq Pt5 (polar Pt3 (+ al (* pi 0.5)) (/ l 2)))
  57.     (if (not (tblsearch "LAYER" "Cen"))
  58.       (command "layer" "m" "Cen" "c" 1 "" "l" "center2" "" "lw"
  59.         0.18 "" "")
  60.     )
  61.     (command "layer" "s" "cen" "")
  62.    (command "line" pt4 pt5 "")
  63.    (setvar "CLAYER" v4)
  64.   )
  65. )
  66. ((= "LWPOLYLINE" lx)
  67.   (progn
  68.     (SETVAR "OSMODE" 0)
  69.     (command "ucs" "w" )
  70.     (setq v4 (getvar "CLAYER"))
  71.     (setq pt1(cdr(assoc 10 en_data))
  72.     )
  73.     (setq listlength(length en_data))
  74.    (setq pt4(cdr(nth (-  listlength 5) en_data)))
  75.     (setq pt3(cdr(nth (-  listlength 9) en_data)))
  76.     (setq pt2(cdr(nth (-  listlength 13) en_data)))
  77.     (setq al(angle pt1 pt2))
  78.     (setq l(distance pt1 pt2))
  79.     (setq h(distance pt1 pt4))
  80.            (command "line" pt1 pt3 "")
  81.     (setq en2 (entlast))
  82.     (command "_divide" en2 2)
  83.     (setq en3(entlast))
  84.     (setq en3_data (entget en3))
  85.     (setq cenpt(cdr(assoc 10 en3_data)))
  86.     (setq pt5(polar cenpt (+ pi al) (* l 0.6)))
  87.     (setq pt6(polar cenpt al (* l 0.6)))
  88.     (setq pt7(polar cenpt (+ al (* pi 1.5)) (* h 0.6)))
  89.     (setq pt8(polar cenpt (+ al (/ pi 2)) (* h 0.6)))
  90.     (command "erase" en2 en3 "")
  91.     (if (not (tblsearch "LAYER" "Cen"))
  92.     (command "layer" "m" "Cen" "c" 1 "" "l" "center2" "" "lw" 0.18 "" "")
  93.   )
  94. (command "layer" "s" "cen" "")    (command "line" pt5 pt6 "")
  95.     (command "line" pt7 pt8 "")
  96.     (setvar "CLAYER" v4)
  97.   )
  98. ))
  99. (setq N (1+ N));循环结束
  100.   );end repeat
  101.     (princ "\n到此一游")
  102.   (setvar "osmode" v1)
  103.   (setvar "cmdecho" v2)
  104.   (setvar "blipmode" v3)
  105.   (princ)
  106. )
回复 支持 反对

使用道具 举报

wanhongron
 楼主| 发表于 2016-8-24 08:56:43 | 显示全部楼层
非常感谢edata大侠，用起来方便多了！！
回复 支持 反对

使用道具 举报

13321287771
发表于 2018-6-25 10:25:48 | 显示全部楼层
对于二维多段线的那种圆还不行啊，大神能改进一下吗
回复 支持 反对

使用道具 举报

evayleung
发表于 2018-6-25 13:34:29 | 显示全部楼层
把二维多段线转换回去一般多段线就行了吧。
回复 支持 反对

使用道具 举报

evayleung
发表于 2018-6-25 13:50:08 | 显示全部楼层
    (setq listlength(length en_data))
   (setq pt4(cdr(nth (-  listlength 5) en_data)))
    (setq pt3(cdr(nth (-  listlength 9) en_data)))
    (setq pt2(cdr(nth (-  listlength 13) en_data)))
这个代码不够友好，至少我在CAD2014下运行不成功，LISTENGTH是35，PT4 PT3 PT2分别是(40 . 0.0) (41 . 0.0) (42 . 0.0)，应该是减的那个数字的区别。
回复 支持 反对

使用道具 举报

hqdwy
发表于 2024-2-16 20:58:45 | 显示全部楼层
本帖最后由 hqdwy 于 2024-2-16 21:03 编辑
evayleung 发表于 2018-6-25 13:50
(setq listlength(length en_data))
   (setq pt4(cdr(nth (-  listlength 5) en_data)))
    (setq  ...

   (setq listlength(length en_data))
   (setq pt4(cdr(nth (-  listlength 6) en_data)))
    (setq pt3(cdr(nth (-  listlength11) en_data)))
    (setq pt2(cdr(nth (-  listlength 16) en_data)))
CAD2016  CAD02020  改成上面的可以了。没有测试其它的，只试了四个顶点的矩形。
回复 支持 反对

使用道具 举报

返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2024-11-15 01:15 , Processed in 0.420182 second(s), 29 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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