求程序修改，一个二维多短线弧线部分转换的程序（求添加扩展数据10币答谢）

yanguangfei

说明：
    一个二维多短线弧线部分转成二维多短线线的程序  程序可以正常运行
    只要修改线上附带扩展数据转换后线应存在扩展数据不可丢失，解决者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 0  ss (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

很难吗?咋没人回信啊

革天明

yanguangfei 发表于 2012-10-20 12:04
很难吗?咋没人回信啊

可以读取原有扩展数据，处理完多段线后再添加上去