这个程序还有几个问题，大家帮忙解决一下！！！
本帖最后由 275437962 于 2013-12-29 12:33 编辑我想让CAD中的所有满足固定长度和角度两个条件（如直线的长度为0.75，角度为0）的直线的中点插入事先命名的块，让新插入块的图层和它对应的直线所在图层一致，并让所有插入块的颜色改成bylayer(即随层)，还有很重要的一点，并将距每一条满足条件直线中点的固定长度范围内（这个范围最好为以每一条直线中点为圆心的虚拟圆）的对象删除（删除的对像包括落在虚拟圆内的对像，也包括与虚拟圆相交的对象；包括每一条满足条件的直线）
说明：里面出现的长度 和角度以及虚拟圆的半径，最好可以更改。
上面是我最初提的问题，有一位朋友写了如下代码，但还存在如下三个问题：
一是“让新插入块的图层和它对应的直线所在图层一致，并让所有插入块的颜色改成bylayer(即随层)”,这个问题还是没有解决，现在程序是新插入块的图层是发生变化了，不是0层，但所有新插入的块的图层对应的应该是案例数据中黄色或紫色线（即满足上面两个条件的直线）所在的图层，现在新插入块的图层对应的是红色的线所在的图层(你可以用程序执行一下下面的“案例数据.dwg”)
二是，我测试时发现的，如果直线的长度不是整的，而是，比如0.75或是0.075，那么这时候直线是不能被选中插入块的
三是，还有就是那个角度条件 ，不起作用，如给成90度，根本就不能达到要求。
(defun c:tt ( / a ang bnm e en i la len pe pm ps pts ss sse ssl)
(vl-load-com)
(vl-cmdf "undo" "be")
(if (and (setq bnm (getstring "\输入块名:"))
(setq ss (ssget '((0 . "line")))))
(progn
(setq i -1 ssl (ssadd))
(while (setq en (ssname ss (setq i (1+ i))))
(setq len (Vlax-Get (Vlax-Ename->Vla-Object en) 'Length )
ang (Vlax-Get (Vlax-Ename->Vla-Object en) 'Angle )
la (Vlax-Get (Vlax-Ename->Vla-Object en) 'Layer )
)
(if (and (= len 1.0) (= ang 0.0));线长,角度可改
(ssadd en ssl)
)
)
(setq i -1)
(while (setq e (ssname ssl (setq i (1+ i))))
(progn
(setq ps (Vlax-Get (Vlax-Ename->Vla-Object e) 'StartPoint )
pe (Vlax-Get (Vlax-Ename->Vla-Object e) 'EndPoint )
pm (mapcar '* '(0.5 0.5 0.5) (mapcar '+ ps pe))
)
(command "circle" pm 1.0);半径可改
(setq a (entlast))
(setq pts (divpts a 500))
(setq sse (ssget "cp" pts))
(command "erase" a sse "")
(command "-insert" bnm pm "0.5" "" "")
(Vlax-Put-Property (Vlax-Ename->Vla-Object (entlast)) 'Layer la)
)
)
)
)
(vl-cmdf "undo" "e")
)
(defun divpts (ename n / ename endparam i nparam pt ptlst startparam)
(setq startparam (vlax-curve-getstartparam ename)
endparam (vlax-curve-getendparam ename)
nparam (/ (- endparam startparam) n)
i -1
ptlst '()
)
(while (<= (setq i (1+ i))
n
)
(setq pt (vlax-curve-getpointatparam ename (* i nparam))
ptlst (cons pt ptlst)
)
)
(reverse ptlst)
)
大家不要理会....问题已经解决,但此人人品巨差,没有支付100明经,最终代码完成代码我已经删除! q3_2006 发表于 2013-12-29 13:25 static/image/common/back.gif
大家不要理会....问题已经解决,但此人人品巨差,没有支付100明经,最终代码完成代码我已经删除!
兄弟，作人要厚道，本来就好100个明经币，结果问题还没解决完，就再要求增加100，还说我没有了，有的时候，人不能太在乎利了，在说，我也没有说不给啊，可以我后来说明了，这个程序还存在一些问题，你根本不理视，做事要有始有终吗，这样别人才会敬重啊！！1 275437962 发表于 2013-12-29 13:43 static/image/common/back.gif
兄弟，作人要厚道，本来就好100个明经币，结果问题还没解决完，就再要求增加100，还说我没有了，有的时候 ...
最终版已经删除...我的演示已经说明问题..图层已经改成直线的层了...并且将图块颜色统一随层....你去准备好100明经币再来悬赏....不然不会有人再相信你的...我的人品,有目共睹! q3_2006 发表于 2013-12-29 13:49 static/image/common/back.gif
最终版已经删除...我的演示已经说明问题..图层已经改成直线的层了...并且将图块颜色统一随层....你去准备 ...
兄弟，咱们先不说人品的问题，你看看我上面的需求以及我后来测试程序发现的问题，你光拿你的演示说事，你说图层已经改成直线的层了，并且将图块颜色统一随层，你最好仔细看看我上面提的问题，“让新插入块的图层和它对应的直线所在图层一致，并让所有插入块的颜色改成bylayer(即随层)，”
还有
“一是“让新插入块的图层和它对应的直线所在图层一致，并让所有插入块的颜色改成bylayer(即随层)”,这个问题还是没有解决，现在程序是新插入块的图层是发生变化了，不是0层，但所有新插入的块的图层对应的应该是案例数据中黄色或紫色线（即满足上面两个条件的直线）所在的图层，现在新插入块的图层对应的是红色的线所在的图层(你可以用程序执行一下下面的“案例数据.dwg”)”
不是和任意直线的图层一致，而是和满足条件直线的图层一致，也就是案例数据中黄色或紫色线的直线，不知道你有没有执行过上面的案例数据，你试了就知道了，执行完新插入的图层的颜色是红色
还有就是后面的两个测试的问题，你有没有试了，我确实发现存在这些问题，我才提出了，也不是我额外提出的，原来的需求里，写的都很清楚，（如直线的长度为0.75，角度为0），你的程序只认整数长度，还有既然允许改角度，那么我试个90度，结果程度不能找到这样的线，
我是就事论事，没有针对人，你上来就说人品不好，太不够意思了吗，当时没有即时给你这100明经币，想着程序还有些问题，而且确实影响使用，所以就暂时没给，唉，我希望这是个误会，不要往心里去！！！我确实是尊重别人劳动成果的，但我觉得拿出让大家都信服的代码更受人尊重！！！
[*]http://bbs.mjtd.com/thread-108828-1-1.html
看下最终版...你到底开了几个帖子....也上了图片...处理后的...
本帖最后由 275437962 于 2013-12-29 18:34 编辑
抱歉抱歉抱歉抱歉 本帖最后由 q3_2006 于 2013-12-30 07:17 编辑
275437962 发表于 2013-12-29 14:49 http://bbs.mjtd.com/static/image/common/back.gif
兄弟，你正面回答，我的问题在上个页面是不是也是这样提的，没有额外增加吧，你敢保证你的程序没有我说明的 ...;;第一版,处理关键直线长度及角度相同的情况
(defun c:tt ( / a ang bnm e en i la len n pe pm ps pts ss sse ssl)
(vl-load-com)
(vl-cmdf "undo" "be")
(if (setq bnm (getstring "\输入块名:"))
(progn
(setq len (getdist "\n输入被替换直线的长度:"))
(setq ang (getangle "\n输入被替换直线的角度:"))
(setq r (getreal "\n输入虚拟圆的半径:"))
(setq ss (ssget '((0 . "line"))))
(setq i -1 ssl (ssadd))
(while (setq en (ssname ss (setq i (1+ i))))
(setq len1 (Vlax-Get (Vlax-Ename->Vla-Object en) 'Length )
ang1 (Vlax-Get (Vlax-Ename->Vla-Object en) 'Angle )
)
(if (and (= len1 len) (= ang1 ang))
(ssadd en ssl)
)
)
(setq n -1)
(while (setq e (ssname ssl (setq n (1+ n))))
(progn
(setq ps (Vlax-Get (Vlax-Ename->Vla-Object e) 'StartPoint )
pe (Vlax-Get (Vlax-Ename->Vla-Object e) 'EndPoint )
pm (mapcar '* '(0.5 0.5 0.5) (mapcar '+ ps pe))
la (Vlax-Get (Vlax-Ename->Vla-Object e) 'Layer )
)
(command "circle" pm r)
(setq a (entlast))
(setq pts (divpts a 500))
(setq sse (ssget "cp" pts))
(command "erase" a sse "")
(command "-insert" bnm pm "" "" "")
(Vlax-Put-Property (Vlax-Ename->Vla-Object (entlast)) 'Layer la)
(vlax-for X
(vla-item (vla-get-blocks
(vla-get-activedocument (vlax-get-acad-object))
)
bnm
)
(setq el (cons (vlax-vla-object->ename X) el))
)
(mapcar '(lambda (x) (VLA-PUT-COLOR (Vlax-Ename->Vla-Object x) 256))el)
)
)
)
)
(command "_.regen")
(vl-cmdf "undo" "e")
)
(defun divpts (ename n / ename endparam i nparam pt ptlst startparam)
(setq startparam (vlax-curve-getstartparam ename)
endparam (vlax-curve-getendparam ename)
nparam (/ (- endparam startparam) n)
i -1
ptlst '()
)
(while (<= (setq i (1+ i))
n
)
(setq pt (vlax-curve-getpointatparam ename (* i nparam))
ptlst (cons pt ptlst)
)
)
(reverse ptlst)
)
(defun c:tt ( / a ang bnm e en i la len n pe pm ps pts ss sse ssl)
(vl-load-com)
(vl-cmdf "undo" "be")
(if (setq bnm (getstring "\输入块名:"))
(progn
(setq len (getdist "\n输入被替换直线的长度:"))
(setq ang (getangle "\n输入被替换直线的角度:"))
(setq r (getreal "\n输入虚拟圆的半径:"))
(setq ss (ssget '((0 . "line"))))
(setq i -1 ssl (ssadd))
(while (setq en (ssname ss (setq i (1+ i))))
(setq len1 (Vlax-Get (Vlax-Ename->Vla-Object en) 'Length )
ang1 (Vlax-Get (Vlax-Ename->Vla-Object en) 'Angle )
)
(if (and (= len1 len) (= ang1 ang))
(ssadd en ssl)
)
)
(setq n -1)
(while (setq e (ssname ssl (setq n (1+ n))))
(progn
(setq ps (Vlax-Get (Vlax-Ename->Vla-Object e) 'StartPoint )
pe (Vlax-Get (Vlax-Ename->Vla-Object e) 'EndPoint )
pm (mapcar '* '(0.5 0.5 0.5) (mapcar '+ ps pe))
la (Vlax-Get (Vlax-Ename->Vla-Object e) 'Layer )
)
(command "circle" pm r)
(setq a (entlast))
(setq pts (divpts a 500))
(setq sse (ssget "cp" pts))
(command "erase" a sse "")
(setvar "clayer" la)
(command "-insert" bnm pm "" "" "")
(vlax-for X
(vla-item (vla-get-blocks
(vla-get-activedocument (vlax-get-acad-object))
)
bnm
)
(setq el (cons (vlax-vla-object->ename X) el))
)
(mapcar '(lambda (x) (VLA-PUT-COLOR (Vlax-Ename->Vla-Object x) 0))el)
)
)
)
)
(command "_.regen")
(vl-cmdf "undo" "e")
)
(defun divpts (ename n / ename endparam i nparam pt ptlst startparam)
(setq startparam (vlax-curve-getstartparam ename)
endparam (vlax-curve-getendparam ename)
nparam (/ (- endparam startparam) n)
i -1
ptlst '()
)
(while (<= (setq i (1+ i))
n
)
(setq pt (vlax-curve-getpointatparam ename (* i nparam))
ptlst (cons pt ptlst)
)
)
(reverse ptlst)
)
处理完这个样子 我什么时候要你加过钱...帮你解决问题还扣屎盆子..你让谁还会再帮你...有人缺这几个虚拟币吗??