找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 12071|回复: 124

[研讨] 智能中心线

 火.. [复制链接]

已领礼包: 604个

财富等级: 财运亨通

发表于 2013-11-19 14:54:17 | 显示全部楼层 |阅读模式

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

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

×
本帖最后由 /db_自贡黄明儒_ 于 2013-11-20 09:09 编辑

经过这两天的奋战和大家的鼎力相助(我就不一一道谢了),智能中心线就差不多{:soso_e113:}
游客,如果您要查看本帖隐藏内容请回复

  1. <P>
  2. ;;中心标记CenterMark By 自贡黄明儒 2013年11月9日***********************************
  3. (defun C:CM (/ *MSP* CIRC CLAYER1 CMDECHO1 E1EN E1ST E2EN E2ST ELLI EN1 EN2 FIL FILTERLST LIN LWP N P0 REG SS VARTXTLST X Y)
  4.   ;;1 错误处理
  5.   (defun *error* (msg)
  6.     (setvar "cmdecho" cmdecho1)
  7.     (setvar "clayer" clayer1)
  8.     (vl-bt)
  9.     (if *DOC*
  10.       (_EndUndo *DOC*)         ;块内图元增减
  11.     )
  12.     (while (not (equal (getvar "cmdnames") "")) (command nil))
  13.     (princ "\n 出错啦!")
  14.     (princ)
  15.   )</P>
  16. <P>  ;;2.1 从选择集中分离出特定选择集
  17.   (defun wmg-ssgetp (ss filter)
  18.     (vl-cmdf "_.select" ss "")
  19.     (ssget "p" filter)
  20.   )</P>
  21. <P>  ;;2.2 分离选择集
  22.   ;; (optimizeCode ss vartxtlst filterlst)
  23.   (defun optimizeCode (ss vartxtlst filterlst)
  24.     (mapcar (function (lambda (x y) (set x (wmg-ssgetp ss y))))
  25.      (mapcar 'read vartxtlst)
  26.      filterlst
  27.     )
  28.   )</P>
  29. <P>  ;;3 面域质心
  30.   (defun HH:REGION (en / CEN LL LST OBJ PX1 PX2 PY1 PY2 R UR)   
  31.       (setq obj (vlax-ename->vla-object en))     
  32.       (setq cen (vlax-safearray->list (vlax-variant-value (vla-get-Centroid obj))))
  33.       (vla-getboundingbox obj'll 'ur)
  34.       (setq lst (mapcar 'vlax-safearray->list (list ll ur)))      
  35.       (setq r (/ (distance (car lst) (cadr lst)) 2.0))
  36.       (setq px1 (mapcar '- cen (list r 0 0)))
  37.       (setq px2 (mapcar '+ cen (list r 0 0)))
  38.       (entmake (list (cons 0 "LINE") (cons 10 px1) (cons 11 px2)))
  39.       (setq py1 (mapcar '- cen (list 0 r 0)))
  40.       (setq py2 (mapcar '+ cen (list 0 r 0)))
  41.       (entmake (list (cons 0 "LINE") (cons 10 py1) (cons 11 py2)))   
  42.   )</P>
  43. <P>  ;;4.1 两线不平行时,画角平分线
  44.   (defun HH:Bisect (en1 en2 / P1E P1S P2E P2S PT1 PT2 PT3 X Y)
  45.     (if (> (distance p0 e1st) (distance p0 e1en))
  46.       (setq p1s e1st
  47.      p1e e1en
  48.       )
  49.       (setq p1s e1en
  50.      p1e e1st
  51.       )
  52.     )
  53.     (if (> (distance p0 e2st) (distance p0 e2en))
  54.       (setq p2s e2st
  55.      p2e e2en
  56.       )
  57.       (setq p2s e2en
  58.      p2e e2en
  59.       )
  60.     )
  61.     (setq PT1 (polar p0 (angle p0 p1s) 10))
  62.     (setq PT2 (polar p0 (angle p0 p2s) 10))
  63.     (setq PT3 (mapcar '(lambda (X Y) (/ (+ X Y) 2.0)) PT1 PT2))</P>
  64. <P>    (setq PT3 (inters p0 PT3 p1s p2s nil))
  65.     (entmake (list (cons 0 "LINE") (cons 10 P0) (cons 11 PT3)))
  66.   )</P>
  67. <P>  ;;4.2 两线平行时,画梯形腰线
  68.   (defun HH:waist (en1 en2 / P0 P3 X Y)
  69.     ;|(setq lst (list (list (distance e1st e2st) e1st e2st)
  70.       (list (distance e1st e2en) e1st e2en)
  71.       (list (distance e1en e2st) e1en e2st)
  72.       (list (distance e1en e2en) e1en e2en)
  73.        )
  74.     )
  75.     ;http://www.xdcad.net/forum/thread-670556-1-4.html HH:ssPts:Sort定义
  76.     (setq lst (car (mapcar 'cdr (HH:ssPts:Sort lst "X" 0.0001)))) ;最远两点
  77.     (if (equal (car lst) e1st 0.001)
  78.       nil
  79.       (setq pt  e1st
  80.      e1st e1en
  81.      e1en pt
  82.       )
  83.     )
  84.     (if (equal (cadr lst) e2en 0.001)
  85.       nil
  86.       (setq pt  e2en
  87.      e2en e2st
  88.      e2st Pt
  89.       )
  90.     )|;
  91.     (if (inters e1st e2st e1en e2en)      
  92.       (progn
  93. (setq P0 (mapcar '(lambda (X Y) (/ (+ X Y) 2.0)) e1st e2en))
  94. (setq P3 (mapcar '(lambda (X Y) (/ (+ X Y) 2.0)) e1en e2st))
  95.       )
  96.       (progn
  97. (setq P0 (mapcar '(lambda (X Y) (/ (+ X Y) 2.0)) e1st e2st))
  98. (setq P3 (mapcar '(lambda (X Y) (/ (+ X Y) 2.0)) e1en e2en))
  99.       )
  100.     )
  101.     (entmake (list (cons 0 "LINE") (cons 10 P0) (cons 11 P3)))   
  102.   )</P>
  103. <P>
  104.   ;;5 圆、弧时,如果中心点没有相互垂直的两条线,画十字中心线
  105.   (defun HH:circleCross (en / ANG1 ANG2 E1EN E1ST E2EN E2ST EN1 EN2 ENT P10 PX1 PX2 PY1 PY2
  106.     R SS)
  107.     (setq ent (entget en))
  108.     (setq p10 (cdr (assoc 10 ent)))
  109.     (setq r (* (cdr (assoc 40 ent)) 1.25))
  110.     (if (and (setq ss (ssget "_C"
  111.         p10
  112.         p10
  113.         (list '(-4 . "<or")    '(0 . "LINE")    '(-4 . "<and")
  114.        '(0 . "LWPOLYLINE")       '(90 . 2)
  115.        '(-4 . "and>")   '(-4 . "or>")
  116.       )
  117.         )
  118.       )
  119.       (cond ((equal (sslength ss) 2)
  120.       (setq en1 (ssname ss 0))
  121.       (setq en2 (ssname ss 1))
  122.       (setq e1st (vlax-curve-getStartPoint en1))
  123.       (setq e1en (vlax-curve-getendPoint en1))
  124.       (setq e2st (vlax-curve-getStartPoint en2))
  125.       (setq e2en (vlax-curve-getendPoint en2))
  126.       (setq ang1 (angle e1st e1en))
  127.       (setq ang2 (angle e2st e2en))
  128.       (equal (rem (- ang1 ang2) (/ pi 2)) 0)
  129.      )
  130.      ((> (sslength ss) 2) T)
  131.      (T nil)
  132.       )
  133. )
  134.       nil
  135.       (progn
  136. (setq px1 (mapcar '- p10 (list r 0 0)))
  137. (setq px2 (mapcar '+ p10 (list r 0 0)))
  138. (entmake (list (cons 0 "LINE") (cons 10 px1) (cons 11 px2)))
  139. (setq py1 (mapcar '- p10 (list 0 r 0)))
  140. (setq py2 (mapcar '+ p10 (list 0 r 0)))
  141. (entmake (list (cons 0 "LINE") (cons 10 py1) (cons 11 py2)))
  142.       )
  143.     )
  144.   )</P>
  145. <P>  ;;6 是平行四边形时画中心线,其它封闭曲线在质心处画十字线
  146.   (defun HH:CenMark (en / CEN LL LST OBJ OBJN P1 P2 PX1 PX2 PY1 PY2 R UR X Y)
  147.     ;;133.2 [功能] 缩放一个点
  148.     ;;scale 'pnt' from a base point of 'p1' by a factor of fact
  149.     (defun scale_pnt (pnt p1 fact /)
  150.       (polar p1 (angle p1 pnt) (* fact (distance p1 pnt)))
  151.     )</P>
  152. <P>    (if (and
  153.    (setq lst (entget en))
  154.    (setq lst (mapcar 'cdr
  155.        (vl-remove-if-not '(lambda (x) (= (car x) 10)) lst)
  156.       )
  157.    )
  158.    (equal (length lst) 4)
  159.    (not (inters (car lst) (cadr lst) (caddr lst) (cadddr lst) nil))
  160.    (not (inters (cadr lst) (caddr lst) (cadddr lst) (car lst) nil))
  161. )
  162.       (progn
  163. (setq cen (mapcar '(lambda (X Y) (/ (+ X Y) 2.0)) (car lst) (caddr lst)))
  164. (setq p1 (mapcar '(lambda (X Y) (/ (+ X Y) 2.0)) (car lst) (cadddr lst)))
  165. (setq p1 (scale_pnt p1 cen 1.25))
  166. (setq p2 (mapcar '(lambda (X Y) (/ (+ X Y) 2.0)) (cadr lst) (caddr lst)))
  167. (setq p2 (scale_pnt p2 cen 1.25))
  168. (entmake (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2)))
  169. (setq p1 (mapcar '(lambda (X Y) (/ (+ X Y) 2.0)) (car lst) (cadr lst)))
  170. (setq p1 (scale_pnt p1 cen 1.25))
  171. (setq p2 (mapcar '(lambda (X Y) (/ (+ X Y) 2.0)) (caddr lst) (cadddr lst)))
  172. (setq p2 (scale_pnt p2 cen 1.25))
  173. (entmake (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2)))
  174.       )
  175.       (progn
  176. (setq obj (vlax-ename->vla-object en))
  177. ;;(setq objN (vla-copy obj))
  178. (or *DOC*
  179.      (setq *DOC* (vla-get-ActiveDocument (vlax-get-acad-object)))
  180. )
  181. (setq *MSP* (vla-get-Modelspace *DOC*))
  182. (vlax-invoke *MSP* 'addregion (list obj))
  183. (setq objN (vlax-ename->vla-object (entlast)))
  184. (setq cen (vlax-safearray->list (vlax-variant-value (vla-get-Centroid objN))))
  185. (vla-getboundingbox objN 'll 'ur)
  186. (setq lst (mapcar 'vlax-safearray->list (list ll ur)))
  187. (vla-delete objN)
  188. (setq r (/ (distance (car lst) (cadr lst)) 2.0))
  189. (setq px1 (mapcar '- cen (list r 0 0)))
  190. (setq px2 (mapcar '+ cen (list r 0 0)))
  191. (entmake (list (cons 0 "LINE") (cons 10 px1) (cons 11 px2)))
  192. (setq py1 (mapcar '- cen (list 0 r 0)))
  193. (setq py2 (mapcar '+ cen (list 0 r 0)))
  194. (entmake (list (cons 0 "LINE") (cons 10 py1) (cons 11 py2)))
  195.       )
  196.     )
  197.   )</P>
  198. <P>  ;;7 椭圆中心标记
  199.   ;;用highflybir的程序改造一下
  200.   (defun HH:ELLIPSEMark (ent / DXF MAJ P1 P10 P2 P3 P4 PTB PTD SS fil)
  201.     (setq fil (list '(-4 . "<or") '(0 . "LINE")     '(-4 . "<and")
  202.       '(0 . "LWPOLYLINE") '(90 . 2)     '(-4 . "and>")
  203.       '(-4 . "or>")
  204.      )
  205.     )
  206.     (setq dxf (entget ent))
  207.     (setq p10 (cdr (assoc 10 dxf)))
  208.     (if (and (setq ss (ssget "_C" p10 p10 fil)) (> (sslength ss) 1))
  209.       nil
  210.       (progn
  211. (setq maj (cdr (assoc 11 dxf)))
  212. (setq ptb (vlax-curve-getPointAtParam ent (* pi 0.5)))
  213. (setq ptd (vlax-curve-getPointAtParam ent (* pi 1.5)))
  214. (setq p1 (mapcar '- ptd maj))
  215. (setq p2 (mapcar '+ ptd maj))
  216. (setq p3 (mapcar '+ ptb maj))
  217. (setq p4 (mapcar '- ptb maj))
  218. (entmake (list (cons 0 "LINE") (cons 10 p1) (cons 11 p3)))
  219. (entmake (list (cons 0 "LINE") (cons 10 p2) (cons 11 p4)))
  220.       )
  221.     )
  222.   )</P>
  223. <P>  ;;8  本程序主程序
  224.   (setq fil (list '(-4 . "<or") '(0 . "CIRCLE") '(0 . "ARC") '(0 . "ELLIPSE") '(0 . "LINE")'(0 . "REGION")
  225.     '(-4 . "<and") '(0 . "LWPOLYLINE") '(-4 . "<or") '(70 . 1) '(90 . 2) '(-4 . "or>")
  226.     '(-4 . "and>") '(-4 . "or>"))
  227.   )
  228.   (if (cadr (ssgetfirst))
  229.     (setq ss (ssget "_P" fil))
  230.     (setq ss (ssget fil))
  231.   )
  232.   (vl-load-com)
  233.   (or *DOC*
  234.       (setq *DOC* (vla-get-ActiveDocument (vlax-get-acad-object)))
  235.   )
  236.   (_StartUndo *DOC*)
  237.   (setq cmdecho1 (getvar "cmdecho"))
  238.   (setq clayer1 (getvar "clayer"))
  239.   (setvar "cmdecho" 0)</P>
  240. <P>  (vl-cmdf "_layer" "make" "中心线" "Color" 6 "" "L" "ACAD_ISO10W100" "" "")
  241.   (setq vartxtlst (list "CIRC" "ELLI" "LIN" "LWP" "REG"))
  242.   (setq filterlst (list (list '(0 . "CIRCLE,ARC"))
  243.    (list '(0 . "ELLIPSE"))
  244.    (list '(-4 . "<or")   '(0 . "LINE")   '(-4 . "<and")
  245.          '(0 . "LWPOLYLINE")       '(90 . 2)
  246.          '(-4 . "and>")  '(-4 . "or>")
  247.         )
  248.    (list '(0 . "LWPOLYLINE") '(70 . 1))
  249.    (list '(0 . "REGION"))
  250.     )
  251.   )
  252.   (optimizeCode ss vartxtlst filterlst)
  253.   (setvar "cmdecho" cmdecho1)
  254.   (if CIRC
  255.     (repeat (setq n (sslength CIRC))
  256.       (HH:circleCross (ssname CIRC (setq n (1- N))))
  257.     )
  258.   )
  259.   (if ELLI
  260.     (repeat (setq n (sslength ELLI))
  261.       (HH:ELLIPSEMark (ssname ELLI (setq n (1- N))))
  262.     )
  263.   )
  264.   (if LWP
  265.     (repeat (setq n (sslength LWP))
  266.       (HH:CenMark (ssname LWP (setq n (1- N))))
  267.     )
  268.   )
  269.   (if REG
  270.     (repeat (setq n (sslength REG))
  271.       (HH:REGION (ssname REG (setq n (1- N))))
  272.     )
  273.   )
  274.   
  275.   ;|(if LIN
  276.     (progn (setq lst (HH:ssPts:Sort LIN "xy" 0.0001))
  277.     (while (> (length lst) 1)
  278.       (setq en1 (car lst))
  279.       (setq en2 (cadr lst))
  280.       (setq lst (cddr lst))
  281.       (setq e1st (vlax-curve-getStartPoint en1))
  282.       (setq e1en (vlax-curve-getendPoint en1))
  283.       (setq e2st (vlax-curve-getStartPoint en2))
  284.       (setq e2en (vlax-curve-getendPoint en2))
  285.       (setq p0 (inters e1st e1en e2st e2en nil))
  286.       (if p0
  287.         (HH:Bisect en1 en2)
  288.         (HH:waist en1 en2)
  289.       )
  290.     )
  291.     )
  292.   )|;
  293.   (if LIN
  294.     (while (> (sslength LIN) 1)
  295.       (setq en1 (ssname LIN 0))
  296.       (setq en2 (ssname LIN 1))
  297.       (ssdel en1 LIN)      
  298.       (ssdel en2 LIN)
  299.       (setq e1st (vlax-curve-getStartPoint en1))
  300.       (setq e1en (vlax-curve-getendPoint en1))
  301.       (setq e2st (vlax-curve-getStartPoint en2))
  302.       (setq e2en (vlax-curve-getendPoint en2))
  303.       (setq p0 (inters e1st e1en e2st e2en nil))
  304.       (if p0
  305. (HH:Bisect en1 en2)
  306. (HH:waist en1 en2)
  307.       )
  308.     )
  309.   )  
  310.   (setvar "clayer" clayer1)
  311.   (_EndUndo *DOC*)
  312.   (gc)
  313.   (princ)
  314. )
  315. ;;中心标记CenterMark By 自贡黄明儒 2013年11月9日***********************************</P>
1.gif

评分

参与人数 1D豆 +5 收起 理由
yularna + 5 很给力!经验;技术要点;资料分享奖!

查看全部评分

论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!

已领礼包: 1268个

财富等级: 财源广进

发表于 2013-11-19 14:56:53 | 显示全部楼层
椭圆的不对吧

点评

那就帮改改吧!  详情 回复 发表于 2013-11-19 15:00
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 604个

财富等级: 财运亨通

 楼主| 发表于 2013-11-19 15:00:51 | 显示全部楼层

那就帮改改吧!

点评

纯 Lisp 太罗嗦了, 一会儿上一个 API 写的  详情 回复 发表于 2013-11-19 15:08
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 1268个

财富等级: 财源广进

发表于 2013-11-19 15:08:38 | 显示全部楼层
本帖最后由 st788796 于 2013-11-19 15:11 编辑

纯 Lisp 太罗嗦了, 一会儿上一个 API 写的

直线就不加了,这个不适合批量处理
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 40个

财富等级: 招财进宝

发表于 2013-11-19 15:45:40 | 显示全部楼层
楼主,两根直线的那个你是怎么定义他们在一起的?

点评

没有考虑,仅用了ssget,如果是先后画的,或者只选择了两条直线,就没有问题;其它情况可能要出错了  详情 回复 发表于 2013-11-19 16:01
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 604个

财富等级: 财运亨通

 楼主| 发表于 2013-11-19 16:01:51 | 显示全部楼层
newer 发表于 2013-11-19 15:45
楼主,两根直线的那个你是怎么定义他们在一起的?

没有考虑,仅用了ssget,如果是先后画的,或者只选择了两条直线,就没有问题;其它情况可能要出错了
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 1268个

财富等级: 财源广进

发表于 2013-11-19 16:10:13 | 显示全部楼层
楼主的本意是在 质心 处画线还是在 Box 中心?这和 ARC 部分 Ellipse 非闭合 pline 有关,闭合线也不能自相交的,情况复杂

点评

我在实际工作发现,自相交闭合曲线这种情况没有出现过,考虑非自相交闭合曲线这种情况就可以。再说,即使自相交,我只求它的质心,一般情况下够用了。  详情 回复 发表于 2013-11-19 16:14
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 604个

财富等级: 财运亨通

 楼主| 发表于 2013-11-19 16:14:10 | 显示全部楼层
st788796 发表于 2013-11-19 16:10
楼主的本意是在 质心 处画线还是在 Box 中心?这和 ARC 部分 Ellipse 非闭合 pline 有关,闭合线也不能自相 ...

我在实际工作发现,自相交闭合曲线这种情况没有出现过,考虑非自相交闭合曲线这种情况就可以。再说,即使自相交,我只求它的质心,一般情况下够用了。

点评

CAD 下的质心算法目前只有面域来求,对规则图形用 XD:nts:Centroid 或者 XDRX_Points_Centroid 能够重合,但曲线的(如 ARC闭合后)前者求得的质心和后两个函数取模拟点求得的质心有一点点误差!  详情 回复 发表于 2013-11-19 16:51
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 1268个

财富等级: 财源广进

发表于 2013-11-19 16:51:24 | 显示全部楼层
/db_自贡黄明儒_ 发表于 2013-11-19 16:14
我在实际工作发现,自相交闭合曲线这种情况没有出现过,考虑非自相交闭合曲线这种情况就可以。再说,即使 ...

CAD 下的质心算法目前只有面域来求,对规则图形用 XD::Pnts:Centroid 或者 XDRX_Points_Centroid 能够重合,但曲线的(如 ARC闭合后)前者求得的质心和后两个函数取模拟点求得的质心有一点点误差!

点评

ARC求质心意义不大,  详情 回复 发表于 2013-11-19 21:28
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 604个

财富等级: 财运亨通

 楼主| 发表于 2013-11-19 21:28:49 来自手机 | 显示全部楼层
st788796 发表于 2013-11-19 16:51
CAD 下的质心算法目前只有面域来求,对规则图形用 XD:nts:Centroid 或者 XDRX_Points_Centroid 能够重 ...

ARC求质心意义不大,

点评

还没有调试  详情 回复 发表于 2013-11-20 00:23
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 1268个

财富等级: 财源广进

发表于 2013-11-20 00:23:27 | 显示全部楼层

还没有调试

  1. (defun c:tt (/ _pi2 mkmark other_center polyline_center ss)
  2.   (setq _pi2 (/ pi 2))
  3.   (defun mkmark        (p an xl yl / hxl hyl p1 p2 p3 p4)
  4.     (setq hxl (* 1.4 xl)
  5.           hyl (* 1.4 yl)
  6.           p1  (polar p an hxl)
  7.           p2  (polar p (+ an pi) hxl)
  8.           p3  (polar p (+ an _pi2) hyl)
  9.           p4  (polar p (- an _pi2) hyl)
  10.     )
  11.     (xdrx_line_make p1 p2)
  12.     (xdrx_entity_setlayer (entlast) "中心线")
  13.     (xdrx_line_make p3 p4)
  14.     (xdrx_entity_setlayer (entlast) "中心线")
  15.   )
  16.   (defun Polyline_center (e / info pts p1 p2 p3 p4 sp radius)
  17.     (setq info (xdrx_curve_info e)
  18.           pts  (xdrx_geom_searchoutline e)
  19.     )
  20.     (cond
  21.       ((XD::Polyline:IsRectang e)
  22.        (mapcar 'set '(p1 p2 p3 p4) pts)
  23.        (mkmark (cdr (assoc "Centroid" info))
  24.                (angle p1 p2)
  25.                (* (distance p1 p2) 0.5)
  26.                (* (distance p2 p3) 0.5)
  27.        )
  28.       )
  29.       ((XD::Polyline:IsPolygon e)
  30.        (setq pcen   (assoc (xdrx_curve_info e))
  31.              sp            (xdrx_curve_getstartpoint e)
  32.              radius (distance sp pcen)
  33.        )
  34.        (mkmark Pcen
  35.                (angle pcen sp)
  36.                radius
  37.                radius
  38.        )
  39.       )
  40.       (t (other_center e))
  41.     )
  42.   )
  43.   (defun other_center (e / info centroid box)
  44.     (setq info           (xdrx_curve_info e)
  45.           centroid (cdr (assoc "Centroid" info))
  46.           box           (mapcar 'abs (apply 'mapcar (cons '- (assoc "Box" info))))
  47.     )
  48.     (mkmark centroid
  49.             centroid
  50.             0.
  51.             (* 0.5 (car box))
  52.             (* 0.5 car box)
  53.     )
  54.   )
  55.   ;;main program
  56.   (if (setq ss (ssget '((0 . "*polyline,arc,circle,ellipse"))))
  57.     (progn
  58.       (xdrx_layer_make "中心线" 6 "ACAD_ISO10W100")
  59.       (mapcar '(lambda (x / typ radius majoraxis)
  60.                  (setq typ (xdrx_getpropertyvalue x "IsA"))
  61.                  (cond
  62.                    ((wcmatch typ "AcDbCircle,AcDbArc")
  63.                     (setq radius (xdrx_getpropertyvalue x "Radius"))
  64.                     (mkmark (xdrx_getpropertyvalue x "Center")
  65.                             0.
  66.                             radius
  67.                             radius
  68.                     )
  69.                    )
  70.                    ((= typ "AcDbEllipse")
  71.                     (setq
  72.                       majoraxis        (xdrx_getpropertyvalue x "MajorAxis")
  73.                     )
  74.                     (mkmark (xdrx_getpropertyvalue x "Center")
  75.                             (angle '(0. 0.) Majoraxis)
  76.                             (xdrx_vector_length Majoraxis)
  77.                             (xdrx_vector_length
  78.                               (xdrx_getpropertyvalue x "MinorAxis")
  79.                             )
  80.                     )
  81.                    )
  82.                    ((= typ "AcDbPolyline")
  83.                     (polyline_center x)
  84.                    )
  85.                    (t (other_center x))
  86.                  )
  87.                )
  88.               (xdrx_pickset->ents ss)
  89.       )
  90.     )
  91.   )
  92.   (princ)
  93. )
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2013-11-20 00:23:29 | 显示全部楼层
这个求中心线程序很好用!
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2013-11-20 00:33:06 | 显示全部楼层
错误: *error* 函数中出错AutoCAD 变量设置被拒绝: "cmdecho" nil
什么原因啊?

点评

怎么解决啊?  详情 回复 发表于 2013-11-20 22:56
缺函数  发表于 2013-11-20 08:59
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2013-11-20 09:56:49 | 显示全部楼层
本帖最后由 myfrankie 于 2013-11-20 09:59 编辑

错误: *error* 函数中出错AutoCAD 变量设置被拒绝: "cmdecho" nil  是怎么回事

点评

你是刚才下载的吗?  详情 回复 发表于 2013-11-20 10:13
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 604个

财富等级: 财运亨通

 楼主| 发表于 2013-11-20 10:13:26 | 显示全部楼层
myfrankie 发表于 2013-11-20 09:56
错误: *error* 函数中出错AutoCAD 变量设置被拒绝: "cmdecho" nil  是怎么回事

你是刚才下载的吗?

点评

对呀 是刚刚下载的  详情 回复 发表于 2013-11-20 11:41
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

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

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2024-3-29 13:27 , Processed in 0.486686 second(s), 64 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

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