批量改标注为直线还有CAD版本的椭圆问题

ynhh

想请教大师

能不能批量选择标注后

把标注的起点到终点改为直线

我的想法，选择时取得标注线的两端点，再线出直线，再删除原标注

这主要用于按原样画出下料图的外形

ynhh

还有一个问题，是在碰巧时
在黑暗中碰到原因的
CAD2010以下版本（如2004，2008）中的椭圆个别尺寸下（如260X90）
在等分双数时，多数情况都会出错
改为单数等分或略改椭圆尺寸后也不会出错
而到2010或以上版本时，就不会出错了

ZZXXQQ

游客，本帖隐藏的内容需要发帖数高于 5 才可浏览，你当前发帖数只有 0

ynhh

ZZXXQQ 发表于 2014-2-28 23:22
[/post]

发自内心的感谢ZZXXQQ
高尚无比的朋友精神
超一流的程序水平
你的存在
让明经永存我心

ZZXXQQ

ynhh 发表于 2014-3-1 12:53
发自内心的感谢ZZXXQQ
高尚无比的朋友精神
超一流的程序水平

板凳又改了，再试试。

ynhh

ZZXXQQ 发表于 2014-3-1 20:05
板凳又改了，再试试。

ZZXXQQ大师
你太好了。
内心对你这样
高技术
高情操
高风格
感激之情，无也言表

ynhh

ZZXXQQ 发表于 2014-2-28 23:22
[/post]

再向大师反映一个问题
第二次优化程序对有的全尺寸图有错误
这一句
(70 . 33) (3 . "140843")
就不用了，因各种图的设置不一样
请大师再看看，都是全部尺寸的图能不能
也达到一步取出外形的功能？

cable2004

参照ZZXXQQ老师的改的
(defun c:tt ()
(setvar "CMDECHO" 0)
(setq pt1 (getpoint "\n窗选第一角点: "))
(setq pt2 (getcorner pt1 "\n另一角点:"))
(if (setq ss (ssget "W" pt1 pt2 '((0 . "DIMENSION") ))) (progn
  (setq i -1 ents nil)
  (repeat (sslength ss)
   (setq ent (entget(ssname ss (setq i (1+ i)))))
   (setq ents (cons (entmake(list '(0 . "LINE") (assoc 10 ent) (cons 11 (cdr(assoc 13 ent))) (assoc 8 ent))) ents))
   (entdel (ssname ss i))
  )
  (setq ss (ssget "W" pt1 pt2))
  (command "_.REGION" ss "")
  (setq ss1 (ssget "W" pt1 pt2 '((0 . "REGION")))
        pl  (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss1)))
        aa  (vl-sort pl (function (lambda (e1 e2 )(> (Vlax-Get (Vlax-Ename->Vla-Object e1) 'Area) (Vlax-Get (Vlax-Ename->Vla-Object e2) 'Area))))))
  (foreach x (cdr aa) (entdel x))
  (command "_.ERASE" (ssget "W" pt1 pt2 '((0 . "*LINE"))) "")
  (command "_.EXPLODE" (car aa) "_.PEDIT" "M" "P" "" "Y" "J" "" "")
))
(setvar "CMDECHO" 1)
(princ)
)

ZZXXQQ

ynhh 发表于 2014-3-1 21:50
再向大师反映一个问题
第二次优化程序对有的全尺寸图有错误
这一句

板凳又改了。

ynhh

cable2004 发表于 2014-3-1 23:04
参照ZZXXQQ老师的改的
(defun c:tt ()
(setvar "CMDECHO" 0)

你这个强,比ZZXXQQ大师的能正常显示
ents nil
                  (function (lambda (e1 e2)
                              (> (Vlax-Get (Vlax-Ename->Vla-Object e1) 'Area)
                                 (Vlax-Get (Vlax-Ename->Vla-Object e2) 'Area)
                              )
                            )
                  )
                )
      )
      (foreach x (cdr aa) (entdel x))
我反得学习对比感觉你是增加了一些内容
你太牛了
真心的感谢你的指点