求程序修改，一个二维多短线弧线部分转换的程序（求添加扩展数据10币答谢）
说明：一个二维多短线弧线部分转成二维多短线线的程序程序可以正常运行
只要修改线上附带扩展数据转换后线应存在扩展数据不可丢失，解决者10币作为答谢！
(defun c:hx (/ ssl i ss mci tudu en tud zeb en1 p1 p2)
(setvar "cmdecho" 0)
(princ "\n选取图面弧线段，请稍候....")
(setq ssl (ssget ":N" '((0 . "POLYLINE")(8 . "~gcd-"))))
(setq i 0ss (ssadd))
(repeat (sslength ssl)
(setq mci (ssname ssl i))
(setq tudu (zb-xl mci 42))
(if (/= (apply '+ tudu) 0)
(setq ss (ssadd mci ss))
)
(setq i (1+ i))
)
(princ "\n共发现")(princ (sslength ss))(princ "条弧线段，正在处理，请稍候....")
(entmake) ;;取消原来错误的entmake函数
;(setq ss (ssget "x" '((0 . "POLYLINE"))))
(command "undo" "be")
(setq i 0)
(repeat (sslength ss)
(setq en0 (ssname ss i))
(entmake (entget en0))
(setq en (entnext en0))
(while(/= "SEQEND" (cdr (assoc 0 (setq zeb (entget en)))))
(setq tud (cdr (assoc 42 zeb)))
(if (equal tud 0 0.00001) ;判断凸起值是否为0，以确定弧段是否为直线段
(entmake zeb) ;若是直线段，则直接创建对象
(progn ;否则......
(setq p1 (cdr (assoc 10 zeb)))
(setq en1 (entnext en))
(if (/= "SEQEND" (cdr (assoc 0 (entget en1))))
(progn
(setq p2 (cdr (assoc 10 (entget en1))))
(hucl p1 p2 tud)
) ;end of__progn-2
(entmake (entget en)) ;;;〈〈〈〈创建主对象〉〉〉〉
) ;end of__if
) ;end of__progn-1
)
(setq en (entnext en))
) ;end of__while
(entmake (list '(0 . "SEQEND")(assoc 8 (entget en))(assoc -3 (entget en'("*")))))
(entdel en0) ;删除原地物
(setq i (1+ i))
(princ "\n")
(princ (- (sslength ss) i))
) ;end of__repeat
(command "undo" "e")
(princ)
)
;;;弧段处理
(defun hucl (hu-p1 hu-p2 hu-tud / d1 d2 an1 an3 p3 p4 cn r len d sp m j npb pp enp)
(setq d1 (/ (distance hu-p1 hu-p2) 2.0))
(setq d2 (* d1 hu-tud)) ;求弧顶高度
(setq an1 (angle hu-p1 hu-p2))
(setq p3 (polar hu-p1 an1 d1)) ;求直线段p1、p2的中点坐标
(setq p4 (polar p3 (- an1 (* pi 0.5)) d2)) ;求曲线段中点坐标
(setq an3 (* (atan hu-tud) 2.0)) ;求弧段切线的角度（也是弧段所对圆心角的一半）
;(setq d3 (/ d1 (/ (sin an3) (cos an3)))) ;sin/cos=tag
;(setq cn (polar p3 (- an1 (* pi 1.5)) d3)) ;求曲线弧对应的圆心坐标
;(setq r (distance hu-p1 cn)) ;求曲线弧对应的圆的半径
;(setq an5 (angle cn hu-p1) an6 (angle cn hu-p2))
(setq r (/ d1 (sin an3))) ;求曲线弧对应的圆的半径
(if (null (tblsearch "layer" "layer11"))
(command "layer" "n" "layer11" "")
)
(setvar "clayer" "layer11")
(setvar "osmode" 0)
(command "arc" hu-p1 p4 hu-p2) ;以p1为起点,p2为终点 画弧
(setq en-arc (entlast))
(setq len (abs (* 2.0 r an3))) ;求弧的长度
;;(command "area" "o" en-arc)
;;(setq len (getvar "PERIMETER"))
;(setq d (+ (fix (* len (abs hu-tud))) 5))
(setq d (+ (fix (/ len 1)) 5))
(if(or (> d 32767)(< d 0)) (setq d 167))
(command "divide" en-arc (1+ d))
(setq sp (ssget "x" '((8 . "layer11") (0 . "POINT"))))
;(setq m (- d 0) j 0)
(setq npb (list '(0 . "VERTEX")'(42 . 0)))
(setq npb (append npb (list (cons 10 hu-p1))));;创建多断线起点
(entmake npb)
(setq j 0)
(while (< j d)
(if (> hu-tud 0)
(setq enp (ssname sp (- d j 1)));选择集最末点
(setq enp (ssname sp j));选择集第一点
)
(setq pp (cdr (assoc 10 (entget enp))))
(setq npb (list '(0 . "VERTEX")'(42 . 0)))
(setq npb (append npb (list (cons 10 pp))))
(entmake npb)
(setq j (1+ j))
) ;end of__while
(setq sse (ssget "X" '((8 . "layer11"))))
(command "erase" sse "")
(setvar "CLAYER" "0")
)
;;;取出顶点凸出值
(defun zb-xl (mci id / mc pw pj)
(setq mc mci)
(setq pj '())
(while (/= (cdr (assoc 0 (entget mc))) "SEQEND")
(setq pw (cdr (assoc id (entget mc))))
(setq pj (cons pw pj))
(setq mc (entnext mc))
)
(setq pj (vl-remove (last pj) pj))
) 很难吗?咋没人回信啊 yanguangfei 发表于 2012-10-20 12:04 static/image/common/back.gif
很难吗?咋没人回信啊
可以读取原有扩展数据，处理完多段线后再添加上去
页:
[1]