批量改标注为直线还有CAD版本的椭圆问题
想请教大师能不能批量选择标注后
把标注的起点到终点改为直线
我的想法，选择时取得标注线的两端点，再线出直线，再删除原标注
这主要用于按原样画出下料图的外形
还有一个问题，是在碰巧时
在黑暗中碰到原因的
CAD2010以下版本（如2004，2008）中的椭圆个别尺寸下（如260X90）
在等分双数时，多数情况都会出错
改为单数等分或略改椭圆尺寸后也不会出错
而到2010或以上版本时，就不会出错了
本帖最后由 ZZXXQQ 于 2014-3-2 07:25 编辑
;尺寸变直线 明经 ZZXXQQ 2014.2.28,2014.3.2
(defun c:tt ()
(setvar "CMDECHO" 0)
(setq pt1 (getpoint "\n窗选第一角点: "))
(setq pt2 (getcorner pt1 "\n另一角点:"))
(if (setq ss (ssget "W" pt1 pt2 '((0 . "DIMENSION") (70 . 33)))) (progn
(setq i -1)
(repeat (sslength ss)
(setq ent (entget(ssname ss (setq i (1+ i)))))
(entmake(list '(0 . "LINE") (assoc 10 ent) (cons 11 (cdr(assoc 13 ent))) (assoc 8 ent)))
(entdel (ssname ss i))
)
(setq ss (ssget "W" pt1 pt2))
(command "_.REGION" ss "" "_.UNION" "W" pt1 pt2 "" "_.ERASE" "W" pt1 pt2 "R" "L" "")
;结果是面域。执行下面命令后无法得到封闭线
;(command "_.EXPLODE" "L" "_.PEDIT" "M" "P" "" "Y" "J" "" "")
))
(setvar "CMDECHO" 1)
(princ)
)
ZZXXQQ 发表于 2014-2-28 23:22 static/image/common/back.gif
发自内心的感谢ZZXXQQ
高尚无比的朋友精神
超一流的程序水平
你的存在
让明经永存我心
ynhh 发表于 2014-3-1 12:53 static/image/common/back.gif
发自内心的感谢ZZXXQQ
高尚无比的朋友精神
超一流的程序水平
板凳又改了，再试试。 ZZXXQQ 发表于 2014-3-1 20:05 static/image/common/back.gif
板凳又改了，再试试。
ZZXXQQ大师
你太好了。
内心对你这样
高技术
高情操
高风格
感激之情，无也言表 ZZXXQQ 发表于 2014-2-28 23:22 static/image/common/back.gif
再向大师反映一个问题
第二次优化程序对有的全尺寸图有错误
这一句
(70 . 33) (3 . "140843")
就不用了，因各种图的设置不一样
请大师再看看，都是全部尺寸的图能不能
也达到一步取出外形的功能？
参照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)
) ynhh 发表于 2014-3-1 21:50 static/image/common/back.gif
再向大师反映一个问题
第二次优化程序对有的全尺寸图有错误
这一句
板凳又改了。 本帖最后由 ynhh 于 2014-3-2 12:20 编辑
cable2004 发表于 2014-3-1 23:04 static/image/common/back.gif
参照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))
我反得学习对比感觉你是增加了一些内容
你太牛了
真心的感谢你的指点
页:
[1]
2