★★批量直线、矩形、圆中心线，唯独圆不行，请大侠指点
工作中经常用到批量直线、矩形、圆中心线，唯独圆不行，程序是在网上收集的，请大侠指点。没有看程序，圆的中心线一大堆，总得规定一个什么东西，我猜少这个。 ;;;△△△批量中心线
(defun C:ZZZZ (/ en en_data lx pt0
nx cenptr pt3xpt3y pt4x pt4y pt5
pt5x pt5y pt6 pt6xpt6y l l1 en3
en1 en1_data en2en2_data)
(terpri)
(setq v1 (getvar "osmode"))
(setq v2 (getvar "cmdecho"))
(setq v3 (getvar "blipmode"))
(setvar "cmdecho" 0)
(setvar "blipmode" 0)
(SETVAR "OSMODE" 0)
(graphscr)
(setq SS (ssget '((0 . "CIRCLE,LINE,*POLYLINE"))));批量选择
(setq N 0)
(repeat (sslength SS);循环开始
(setq en (ssname ss N))
(setq en_data (entget en))
(setq lx_list (assoc 0 en_data))
(setq lx (cdr lx_list))
(cond ((= "CIRCLE" lx)
(progn
(setq v4 (getvar "CLAYER"))
;(setq pt0 (cadr en))
(setq nx (cdr (assoc 0 en_data)))
;(setq cenpt (osnap pt0 "center"))
(setq cenpt (cdr (assoc 10 en_data)))
(setq r (cdr (assoc 40 en_data)))
(setq pt1 (polar cenpt pi (+ (* r 0.2) r)))
(setq pt2 (polar cenpt 0 (+ (* r 0.2) r)))
(setq pt3 (polar cenpt (* 0.5 pi) (+ (* r 0.2) r)))
(setq pt4 (polar cenpt (* 1.5 pi) (+ (* r 0.2) r)))
(command "osnap" "none")
(if (not (tblsearch "LAYER" "Cen"))
(command "layer" "m" "Cen" "c" 1 "" "l" "center2" "" "lw"
0.18 "" "")
)
(command "layer" "s" "cen" "")
(command "line" pt1 pt2 "")
(command "line" pt3 pt4 "")
(setvar "CLAYER" v4)
)
)
((= "LINE" lx)
(progn
(SETVAR "OSMODE" 0)
(command "ucs" "w" )
(setq v4 (getvar "CLAYER"))
(setq ent (entget en))
(setq Pt1 (cdr (assoc 10 ent)))
(setq Pt2 (cdr (assoc 11 ent)))
(setq l (distance Pt1 Pt2))
(setq al (angle Pt1 Pt2))
(setq Pt3 (polar Pt1 al (/ l 2)))
(setq Pt4 (polar Pt3 (+ al (* pi 1.5)) (/ l 2)))
(setq Pt5 (polar Pt3 (+ al (* pi 0.5)) (/ l 2)))
(if (not (tblsearch "LAYER" "Cen"))
(command "layer" "m" "Cen" "c" 1 "" "l" "center2" "" "lw"
0.18 "" "")
)
(command "layer" "s" "cen" "")
(command "line" pt4 pt5 "")
(setvar "CLAYER" v4)
)
)
((= "LWPOLYLINE" lx)
(progn
(SETVAR "OSMODE" 0)
(command "ucs" "w" )
(setq v4 (getvar "CLAYER"))
(setq pt1(cdr(assoc 10 en_data))
)
(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)))
(setq al(angle pt1 pt2))
(setq l(distance pt1 pt2))
(setq h(distance pt1 pt4))
(command "line" pt1 pt3 "")
(setq en2 (entlast))
(command "_divide" en2 2)
(setq en3(entlast))
(setq en3_data (entget en3))
(setq cenpt(cdr(assoc 10 en3_data)))
(setq pt5(polar cenpt (+ pi al) (* l 0.6)))
(setq pt6(polar cenpt al (* l 0.6)))
(setq pt7(polar cenpt (+ al (* pi 1.5)) (* h 0.6)))
(setq pt8(polar cenpt (+ al (/ pi 2)) (* h 0.6)))
(command "erase" en2 en3 "")
(if (not (tblsearch "LAYER" "Cen"))
(command "layer" "m" "Cen" "c" 1 "" "l" "center2" "" "lw" 0.18 "" "")
)
(command "layer" "s" "cen" "") (command "line" pt5 pt6 "")
(command "line" pt7 pt8 "")
(setvar "CLAYER" v4)
)
))
(setq N (1+ N));循环结束
);end repeat
(princ "\n到此一游")
(setvar "osmode" v1)
(setvar "cmdecho" v2)
(setvar "blipmode" v3)
(princ)
)
非常感谢edata大侠，用起来方便多了！！ 对于二维多段线的那种圆还不行啊，大神能改进一下吗 把二维多段线转换回去一般多段线就行了吧。 (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 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)))
CAD2016CAD02020改成上面的可以了。没有测试其它的，只试了四个顶点的矩形。
页:
[1]