求MLINE线转PLINE线[已解决]

weiqi · 发表于 2012-12-26 20:08:31

本帖最后由 weiqi 于 2013-1-19 20:39 编辑

问题解决，虽然代码丑陋~~附件，为PL线加ML线~和 ML线加PL线

--------------------------------------------------------------------------------------------------------
--------------------------------------------------------------------------------------------------------

weiqi · 发表于 2013-1-18 20:58:26

本帖最后由 weiqi 于 2013-1-18 20:59 编辑

找到一个G版的 ML线转直线

;|5.【非图形对象操作】20分
在禁用炸开命令的前提下，将将MLINE转换为LINE。
|;
;;
;; Copyright (c)2011.12.31 Gu_xl
;; 版权所有 Gu_xl
;;
;;作者保留本程序的一切权利，但你可以自由拷贝与复制、修改本程序用于非商业目的。
;;作者尽力将本程序做得完善，但不会因本软件的错失而造成的损失承担任何责任。
;;本程序仅提供作为应用上的参考, 而未声明或隐含任何保证; 对于任何特殊用途之适
;;应性, 以及商业销售所隐含作出的保证, 在此一概予以否认。
;;
(vl-load-com)
;;;*************函数 gxl-codestrip.lsp *************
;; | ---------------------------------------------------------------------------
;; | (gxl-CodeStrip entl StripLst) 将entl表剔除StripLst表中的组码值
;;;(gxl-CodeStrip (entget (car(entsel))) (list 330 -1 5 8 70 100 10))
(defun gxl-CodeStrip( entl StripLst)
(vl-remove-if '(lambda ( a ) (vl-position (car a) StripLst)) entl)
)
;;;***************** 函数 gxl-CodeStrip*****************
;;;*************函数 gxl-listmlstyle.lsp *************
;;;打印多样式数据表
;;;(gxl-listmlstyle "Standard")
(defun gxl-listmlstyle (name / mltable ent flag)
(setq mltable (dictsearch (namedobjdict) "ACAD_MLINESTYLE")
flag t)
(while (and flag mltable)
(setq data (car mltable)
mltable (cdr mltable)
)
(if (= 3 (car data))
(if (= (strcase name) (strcase (cdr data)))
(setq flag nil
ent (cdar mltable)
)
)
)
)
(if ent
(progn
(setq ent (entget ent))
(GXL-CODESTRIP ent (list -1 5 102 330))
)
)
)
;;;***************** 函数 gxl-listmlstyle*****************
;;;*************函数 gxl-listp.lsp *************
;;;(gxl-listp lst) 判断表是否为真正的表,非nil、非点对表
;;;(gxl-listp nil) nil (gxl-listp '(1 . 2)) (gxl-listp '(1 2))
(defun gxl-listp (lst)
(and (vl-consp lst)
(vl-list-length lst)
)
)
;;;***************** 函数 gxl-listp*****************
;;;*************函数 gxl-dxf.lsp *************
(defun gxl-dxf (ent i)
(if (= (type ent) 'ename)
(setq ent (entget ent '("*")))
)
(cond ((atom i)
(cdr (assoc i ent))
)
((gxl-listp i)
(mapcar '(lambda (x) (cdr (assoc x ent))) i)
)
)
)
;;;***************** 函数 gxl-dxf*****************
;;;*************函数 gxl-midpoint.lsp *************
;;;==================================================================
;;;gxl-MidPoint 表操作函数,计算两点的中点
;;;计算两点的中点
;;;==================================================================
(defun gxl-MidPoint (p1 p2)
(if (and (> (length p1) 2)(> (length p2) 2))
(list (* 0.5 (+ (car p1) (car p2))) (* 0.5 (+ (cadr p1) (cadr p2))) (* 0.5 (+ (caddr p1) (caddr p2))))
(list (* 0.5 (+ (car p1) (car p2))) (* 0.5 (+ (cadr p1) (cadr p2))))
)
)
;;;***************** 函数 gxl-MidPoint*****************
;;;*************函数 gxl-sel-entnextall.lsp *************
;;;gxl-Sel-EntNextAll en 返回 en 之后的所有物体选择集，无则返回 nil,en为nil返回图形全部图元
(defun gxl-Sel-EntNextAll (ent / ss)
(if (not ent)
(progn
(setq ent (entnext))
(if ent
(setq ss (ssadd ent))
(setq ss (ssadd))
)
)
(setq ss (ssadd))
)
(while (setq ent (entnext ent))
(if (not (member (cdr (assoc 0 (entget ent))) '("ATTRIB" "VERTEX" "SEQEND")))
(ssadd ent ss)
)
)
(if (= 0 (sslength ss))
nil
ss
)
)
;;;***************** 函数 gxl-Sel-EntNextAll*****************
;;;(gxl-Sel-Mapcar ss Fun) 遍历选择集对所包含的图元进行指定函数操作,返回操作后的表
(defun gxl-Sel-Mapcar (ss Fun / nn rtn)
(if ss
(repeat (setq nn (sslength ss))
(setq rtn (cons (apply Fun (list (ssname ss (setq nn (1- nn))))) rtn))
)
)
)
;;;*************************************************
;| 参数：mldata 多线样式组码表
(setq mldata '((0 . "MLINESTYLE")
(100 . "AcDbMlineStyle")
(2 . "A0") ;_ 多线样式名
(70 . 1634) ;_ 70 标志（按位编码）：
;_ 1 =填充
;_ 2 = 显示斜接
;_ 16 = 开始矩形结束（直线）封口
;_ 32 = 开始内弧封口
;_ 64 = 开始圆（外弧）封口
;_ 256 = 结束矩形（直线）封口
;_ 512 = 结束内弧封口
;_ 1024 = 结束圆（外弧）封口
(3 . "") ;_ 样式说明（字符串，最多为 255 个字符）
(62 . 0) ;_ 填充颜色（整数，默认值 = 256）
(51 . 1.5708) ;_ 起点角度（实数，默认值为 90 度）
(52 . 1.5708) ;_端点角度（实数，默认值为 90 度
(71 . 2)　　　　　　　　　;_ 元素数
(49 . 0.5) ;_ 元素偏移（实数，无默认值）。可以存在多个条目；每个元素一个条目
(62 . 256) ;_ 元素颜色（整数，默认值 = 0）。可以存在多个条目；每个元素一个条目
(6 . "权界线共有") ;_ 元素线型（字符串，默认值 = 随层）。可以存在多个条目；每个元素一个条目
(49 . -0.5) ;_ 元素偏移（实数，无默认值）。可以存在多个条目；每个元素一个条目
(62 . 256) ;_ 元素颜色（整数，默认值 = 0）。可以存在多个条目；每个元素一个条目
(6 . "权界线共有") ;_ 元素线型（字符串，默认值 = 随层）。可以存在多个条目；每个元素一个条目
)
)
|;
;;;(gxl-ml2line mline) 多线转直线
;;;(gxl-ml2line (car(entsel)))
(defun gxl-ml2line (MLINE / MAKELINE MAKEARC MLDATA
MLTYPEDATA DXF70 LINETYPES
COLORS DISPLAYJIONS SCALE
ALIGN CLOSEDP LAYER BASEPT
ANG1 ANG2 STARTANG NEWPTS
NUM PTS PT P1
P2 MP N K
NODEPTS NEXTNODE OLDPTS STPTS
ENDANG ENDPTS TMPPT TMPCOLORS
TMPLTYPES LOOP CP EndEntity
)
(defun makeline (p1 p2 Ltype layer color)
(entmake
(list '(0 . "line")
(cons 8 layer)
(cons 62 color)
(cons 6 ltype)
(cons 10 p1)
(cons 11 p2)
)
)
(entlast)
)
(defun makeArc (cp p1 p2 Ltype layer color)
(entmake
(list '(0 . "arc")
(cons 8 layer)
(cons 62 color)
(cons 6 ltype)
(cons 10 cp)
(cons 40 (distance cp p1))
(cons 50 (angle cp p1))
(cons 51 (angle cp p2))
)
)
)
(setq EndEntity (entlast))
(setq mldata (entget mline))
(setq Mltypedata (gxl-listmlstyle (gxl-dxf mline 2))) ;_ 多线样式表
(setq dxf70 (gxl-dxf Mltypedata 70))
(setq LineTypes (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 6 (car x))) Mltypedata))) ;_ 线型表
(setq Colors (cdr (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 62 (car x))) Mltypedata)))) ;_颜色表
(setq DisPlayJions (= 2 (logand dxf70 2))) ;_ 2 = 显示斜接
(setq scale (gxl-dxf mline 40) ;_ 比例因子
align (gxl-dxf mline 40) ;_ 对正：0 = 上；1 = 无；2 = 下
closedp (= 2 (logand (gxl-dxf mline 71) 2)) ;_ 是否闭合
layer (gxl-dxf mline 8)
)
(setq mldata (member (assoc 11 mldata) mldata))
(while (= (caar mldata) 11) ;_ 一个线段开始
(setq basept (gxl-dxf mldata 11) ;_ 顶点
ang1 (angle '(0 0 0) (gxl-dxf mldata 12)) ;_ 从该顶点开始的线段的方向角度
ang2 (angle '(0 0 0) (gxl-dxf mldata 13)) ;_ 此顶点处的斜接方向角度
mldata (cdddr mldata)
)
(if (null StartAng)(setq StartAng ang1)) ;_ 储存起点直线方向
(setq NewPts nil)
(while (= 74 (caar mldata)) ;_ 一个顶点开始
(setq Num (cdar mldata) ;_ 元素的参数数目
mldata (cdr mldata)
pts nil ;_ 直线段点清空
)
(setq pt (polar basept ang2 (cdar mldata)) ;_ 斜接方向点
mldata (cdr mldata)
pt (polar pt ang1 (cdar mldata)) ;_ 直线方向点
mldata (cdr mldata)
)
(setq pts (cons pt pts))
(repeat (- num 2) ;_ 含打断点
(setq pts (cons (polar pt ang1 (cdar mldata)) pts)
mldata (cdr mldata)
)
)
(setq mldata (cdr mldata)
pts (reverse pts) ;_ 一条直线段点
NewPts (cons pts NewPts)
)
)
(setq NewPts (reverse NewPts))
(if DisPlayJions ;_ 显示斜接
(progn
(setq p1 (caar NewPts)
p2 (car (last NewPts))
mp (GXL-MIDPOINT p1 p2)
)
(makeline p1 mp (car LineTypes) layer (car colors))
(makeline mp p2 (last LineTypes) layer (last colors))
)
)
(if oldPts
(progn
(setq n 0 k 0)
(repeat (length oldpts)
(setq NodePts (nth n oldpts) ;_ 上一直线结点坐标
nextNode (car (nth n NewPts)) ;_ 本段直线起点
n (1+ n)
)
(setq NodePts (append NodePts (list nextNode)))
(makeline (car NodePts) (cadr NodePts) (nth k LineTypes) layer (nth k colors)) ;_ 划线
(setq NodePts (cddr NodePts))
(while NodePts
(makeline (car NodePts) (cadr NodePts) (nth k LineTypes) layer (nth k colors)) ;_ 划线
(setq NodePts (cddr NodePts))
)
(setq k (1+ k))
)
(setq oldPts NewPts)
)
(setq oldPts NewPts
stpts (mapcar 'car NewPts) ;_ 保存起始结点点
)
)
)
(setq EndAng ang1) ;_ 储存终点直线方向
(setq endpts(mapcar 'car NewPts)) ;_ 保存起始结点
(if closedp
(progn
(apply 'mapcar (list 'makeline stpts endpts LineTypes (mapcar '(lambda(x) layer) stpts) colors)) ;_ 绘制闭合线
)
(progn
(if (not DisPlayJions) ;_ 不显示斜接
(progn
(if (= 16 (logand dxf70 16)) ;_ 16 = 开始矩形结束（直线）封口
(progn
(if (> (length stpts) 1)
(progn
(makeline (car stpts) (last stpts) "BYLAYER" layer 256)
)
)
)
)
(if (= 256 (logand dxf70 256)) ;_ 256 = 结束矩形（直线）封口
(progn
(if (> (length endpts) 1)
(progn
(makeline (car endpts) (last endpts) "BYLAYER" layer 256)
)
)
)
)
)
)
(if (= 64 (logand dxf70 64)) ;_ 64 = 开始圆（外弧）封口
(progn
(setq tmppt stpts tmpcolors colors tmpltypes LineTypes)
(setq p1 (car tmppt) ;_ 弧端点
p2 (last tmppt) ;_ 弧端点
cp (GXL-MIDPOINT p1 p2) ;_ 圆心点
mp (polar cp StartAng (- (distance cp p1))) ;_ 圆弧中点
)
(makeArc cp p1 mp (car tmpltypes) layer (car tmpcolors))
(makeArc cp mp p2 (car tmpltypes) layer (last tmpcolors))
)
)
(if (= 32 (logand dxf70 32)) ;_ 32 = 开始内弧封口
(progn
(setq tmppt stpts tmpcolors colors tmpltypes LineTypes)
(setq tmppt (reverse (cdr (reverse (cdr tmppt)))))
(setq tmpcolors (reverse (cdr (reverse (cdr tmpcolors)))))
(setq tmpltypes (reverse (cdr (reverse (cdr tmpltypes)))))
(while (> (length tmppt) 1)
(setq p1 (car tmppt) ;_ 弧端点
p2 (last tmppt) ;_ 弧端点
cp (GXL-MIDPOINT p1 p2) ;_ 圆心点
mp (polar cp StartAng (- (distance cp p1))) ;_ 圆弧中点
)
(makeArc cp p1 mp (car tmpltypes) layer (car tmpcolors))
(makeArc cp mp p2 (car tmpltypes) layer (last tmpcolors))
(setq tmppt (reverse (cdr (reverse (cdr tmppt)))))
(setq tmpcolors (reverse (cdr (reverse (cdr tmpcolors)))))
(setq tmpltypes (reverse (cdr (reverse (cdr tmpltypes)))))
)
)
)
(if (= 1024 (logand dxf70 1024)) ;_ 1024 = 结束圆（外弧）封口
(progn
(setq tmppt endpts tmpcolors colors tmpltypes LineTypes)
(setq p1 (car tmppt) ;_ 弧端点
p2 (last tmppt) ;_ 弧端点
cp (GXL-MIDPOINT p1 p2) ;_ 圆心点
mp (polar cp EndAng (distance cp p1)) ;_ 圆弧中点
)
(makeArc cp mp p1 (car tmpltypes) layer (car tmpcolors))
(makeArc cp p2 mp (car tmpltypes) layer (last tmpcolors))
)
)
(if (= 512 (logand dxf70 512)) ;_ 512 = 结束内弧封口
(progn
(setq tmppt endpts tmpcolors colors tmpltypes LineTypes)
(setq tmppt (reverse (cdr (reverse (cdr tmppt)))))
(setq tmpcolors (reverse (cdr (reverse (cdr tmpcolors)))))
(setq tmpltypes (reverse (cdr (reverse (cdr tmpltypes)))))
(while (> (length tmppt) 1)
(setq p1 (car tmppt) ;_ 弧端点
p2 (last tmppt) ;_ 弧端点
cp (GXL-MIDPOINT p1 p2) ;_ 圆心点
mp (polar cp EndAng (distance cp p1)) ;_ 圆弧中点
)
(makeArc cp mp p1 (car tmpltypes) layer (car tmpcolors))
(makeArc cp p2 mp (car tmpltypes) layer (last tmpcolors))
(setq tmppt (reverse (cdr (reverse (cdr tmppt)))))
(setq tmpcolors (reverse (cdr (reverse (cdr tmpcolors)))))
(setq tmpltypes (reverse (cdr (reverse (cdr tmpltypes)))))
)
)
)
)
)
(entdel mline) ;_ 删除多线
(GXL-SEL-ENTNEXTALL EndEntity) ;_ 返回选择直线集
)
(defun c:tt5 ()
(princ "\n***多线转直线，请选择多线: ")
(setq ss (ssget ":L" '((0 . "mline"))))
(GXL-SEL-MAPCAR ss 'GXL-ML2LINE)
(princ)
)

;|5.【非图形对象操作】20分 
   在禁用炸开命令的前提下，将将MLINE转换为LINE。 
   |; 
;; 
;; Copyright (c)2011.12.31 Gu_xl 
;; 版权所有  Gu_xl 
;; 
;;作者保留本程序的一切权利，但你可以自由拷贝与复制、修改本程序用于非商业目的。 
;;作者尽力将本程序做得完善，但不会因本软件的错失而造成的损失承担任何责任。 
;;本程序仅提供作为应用上的参考, 而未声明或隐含任何保证; 对于任何特殊用途之适 
;;应性, 以及商业销售所隐含作出的保证, 在此一概予以否认。 
;; 
(vl-load-com) 
;;;*************函数 gxl-codestrip.lsp  ************* 
;; | --------------------------------------------------------------------------- 
;; | (gxl-CodeStrip entl StripLst) 将entl表 剔除StripLst表中的组码值 
;;;(gxl-CodeStrip (entget (car(entsel))) (list 330 -1 5 8 70 100 10)) 
(defun gxl-CodeStrip( entl StripLst) 
(vl-remove-if '(lambda ( a ) (vl-position (car a) StripLst)) entl) 
) 
;;;***************** 函数 gxl-CodeStrip***************** 
 
;;;*************函数 gxl-listmlstyle.lsp  ************* 
;;;打印多样式数据表 
;;;(gxl-listmlstyle "Standard") 
(defun gxl-listmlstyle (name / mltable ent flag) 
  (setq mltable (dictsearch (namedobjdict) "ACAD_MLINESTYLE") 
flag t) 
  (while (and flag mltable) 
    (setq data (car mltable) 
   mltable (cdr mltable) 
   ) 
    (if (= 3 (car data)) 
      (if (= (strcase name) (strcase (cdr data))) 
(setq flag nil 
       ent (cdar mltable) 
       ) 
) 
      ) 
    ) 
  (if ent 
    (progn 
    (setq ent (entget ent)) 
    (GXL-CODESTRIP ent (list -1 5 102 330)) 
    ) 
    ) 
  ) 
;;;***************** 函数 gxl-listmlstyle***************** 
 
;;;*************函数 gxl-listp.lsp  ************* 
;;;(gxl-listp lst) 判断表是否为真正的表,非nil、非点对表 
;;;(gxl-listp nil) nil (gxl-listp '(1 . 2)) (gxl-listp '(1  2)) 
(defun gxl-listp (lst) 
  (and (vl-consp lst) 
       (vl-list-length lst) 
       ) 
  ) 
;;;***************** 函数 gxl-listp***************** 
 
;;;*************函数 gxl-dxf.lsp  ************* 
(defun gxl-dxf (ent i) 
  (if (= (type ent) 'ename) 
    (setq ent (entget ent '("*"))) 
    ) 
  (cond ((atom i) 
  (cdr (assoc i ent)) 
  ) 
((gxl-listp i) 
  (mapcar '(lambda (x) (cdr (assoc x ent))) i) 
  ) 
) 
  ) 
;;;***************** 函数 gxl-dxf***************** 
 
;;;*************函数 gxl-midpoint.lsp  ************* 
;;;================================================================== 
;;;gxl-MidPoint 表操作函数,计算两点的中点 
;;;计算两点的中点 
;;;================================================================== 
(defun gxl-MidPoint (p1 p2) 
  (if (and (> (length p1) 2)(> (length p2) 2)) 
      (list (* 0.5 (+ (car p1) (car p2))) (* 0.5 (+ (cadr p1) (cadr p2))) (* 0.5 (+ (caddr p1) (caddr p2)))) 
      (list (* 0.5 (+ (car p1) (car p2))) (* 0.5 (+ (cadr p1) (cadr p2)))) 
  )   
  ) 
;;;***************** 函数 gxl-MidPoint***************** 
 
;;;*************函数 gxl-sel-entnextall.lsp  ************* 
;;;gxl-Sel-EntNextAll en 返回 en 之后的所有物体选择集，无则返回 nil,en为nil返回图形全部图元 
(defun gxl-Sel-EntNextAll (ent / ss) 
  (if (not ent) 
    (progn 
      (setq ent (entnext)) 
    (if ent 
      (setq ss (ssadd ent)) 
      (setq ss (ssadd)) 
      ) 
  ) 
    (setq ss (ssadd)) 
    ) 
  (while (setq ent (entnext ent)) 
    (if (not (member (cdr (assoc 0 (entget ent))) '("ATTRIB" "VERTEX" "SEQEND"))) 
      (ssadd ent ss) 
      ) 
    ) 
  (if (= 0 (sslength ss)) 
    nil 
    ss 
    ) 
  ) 
;;;***************** 函数 gxl-Sel-EntNextAll***************** 
;;;(gxl-Sel-Mapcar ss Fun) 遍历选择集对所包含的图元进行指定函数操作,返回操作后的表 
(defun gxl-Sel-Mapcar (ss Fun / nn rtn) 
  (if ss 
  (repeat (setq nn (sslength ss)) 
  (setq rtn (cons (apply Fun (list (ssname ss (setq nn (1- nn))))) rtn)) 
    ) 
    ) 
  ) 
 
;;;************************************************* 
;| 参数：mldata 多线样式组码表 
(setq mldata '((0 . "MLINESTYLE") 
     (100 . "AcDbMlineStyle") 
     (2 . "A0")                ;_ 多线样式名 
     (70 . 1634)               ;_ 70 标志（按位编码）： 
          ;_ 1 =填充 
          ;_ 2 = 显示斜接 
          ;_ 16 = 开始矩形结束（直线）封口 
          ;_ 32 = 开始内弧封口 
          ;_ 64 = 开始圆（外弧）封口 
          ;_ 256 = 结束矩形（直线）封口 
          ;_ 512 = 结束内弧封口 
          ;_ 1024 = 结束圆（外弧）封口 
     (3 . "")                  ;_ 样式说明（字符串，最多为 255 个字符） 
     (62 . 0)                  ;_ 填充颜色（整数，默认值 = 256） 
     (51 . 1.5708)             ;_ 起点角度（实数，默认值为 90 度） 
     (52 . 1.5708)             ;_端点角度（实数，默认值为 90 度 
     (71 . 2)　　　　　　　　　;_ 元素数 
     (49 . 0.5)                ;_ 元素偏移（实数，无默认值）。可以存在多个条目；每个元素一个条目 
     (62 . 256)                ;_ 元素颜色（整数，默认值 = 0）。可以存在多个条目；每个元素一个条目 
     (6 . "权界线共有")        ;_ 元素线型（字符串，默认值 = 随层）。可以存在多个条目；每个元素一个条目 
     (49 . -0.5)               ;_ 元素偏移（实数，无默认值）。可以存在多个条目；每个元素一个条目 
     (62 . 256)                ;_ 元素颜色（整数，默认值 = 0）。可以存在多个条目；每个元素一个条目 
     (6 . "权界线共有")        ;_ 元素线型（字符串，默认值 = 随层）。可以存在多个条目；每个元素一个条目 
   ) 
) 
|; 
;;;(gxl-ml2line mline) 多线转直线 
;;;(gxl-ml2line (car(entsel))) 
(defun gxl-ml2line (MLINE /  MAKELINE  MAKEARC   MLDATA 
         MLTYPEDATA    DXF70     LINETYPES 
         COLORS  DISPLAYJIONS      SCALE 
         ALIGN  CLOSEDP   LAYER     BASEPT 
         ANG1  ANG2    STARTANG  NEWPTS 
         NUM  PTS    PT      P1 
         P2  MP    N      K 
         NODEPTS  NEXTNODE  OLDPTS    STPTS 
         ENDANG  ENDPTS    TMPPT     TMPCOLORS 
         TMPLTYPES LOOP    CP EndEntity 
        )   
  (defun makeline (p1 p2 Ltype layer color) 
    (entmake 
      (list '(0 . "line") 
     (cons 8 layer) 
     (cons 62 color) 
     (cons 6 ltype) 
     (cons 10 p1) 
     (cons 11 p2) 
     ) 
      ) 
    (entlast) 
    ) 
  (defun makeArc (cp p1 p2 Ltype layer color) 
    (entmake 
      (list '(0 . "arc") 
     (cons 8 layer) 
     (cons 62 color) 
     (cons 6 ltype) 
     (cons 10 cp) 
     (cons 40 (distance cp p1)) 
     (cons 50 (angle cp p1)) 
     (cons 51 (angle cp p2)) 
      ) 
    ) 
  ) 
  (setq EndEntity (entlast)) 
  (setq mldata (entget mline)) 
  (setq Mltypedata (gxl-listmlstyle (gxl-dxf mline 2))) ;_ 多线样式表 
  (setq dxf70 (gxl-dxf Mltypedata 70)) 
  (setq LineTypes (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 6 (car x))) Mltypedata))) ;_ 线型表 
  (setq Colors (cdr (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 62 (car x))) Mltypedata)))) ;_颜色表 
  (setq DisPlayJions (= 2 (logand dxf70 2))) ;_ 2 = 显示斜接 
  (setq scale (gxl-dxf mline 40) ;_ 比例因子 
align (gxl-dxf mline 40) ;_ 对正：0 = 上；1 = 无；2 = 下 
closedp  (= 2 (logand (gxl-dxf mline 71) 2)) ;_ 是否闭合 
layer (gxl-dxf mline 8) 
) 
  (setq mldata (member (assoc 11 mldata) mldata)) 
  (while (= (caar mldata) 11) ;_ 一个线段开始 
    (setq basept (gxl-dxf mldata 11) ;_ 顶点 
   ang1 (angle '(0 0 0) (gxl-dxf mldata 12)) ;_ 从该顶点开始的线段的方向角度 
   ang2 (angle '(0 0 0) (gxl-dxf mldata 13)) ;_ 此顶点处的斜接方向角度 
   mldata (cdddr mldata) 
   ) 
    (if (null StartAng)(setq StartAng ang1)) ;_ 储存起点直线方向 
    (setq NewPts nil) 
    (while (= 74 (caar mldata)) ;_ 一个顶点开始 
       (setq Num    (cdar mldata) ;_ 元素的参数数目 
      mldata (cdr mldata) 
      pts nil ;_ 直线段点清空 
       ) 
      (setq pt (polar basept ang2 (cdar mldata)) ;_ 斜接方向点 
        mldata (cdr mldata) 
        pt (polar pt ang1 (cdar mldata)) ;_ 直线方向点 
        mldata (cdr mldata) 
        ) 
      (setq pts (cons pt pts)) 
      (repeat (- num 2) ;_ 含打断点 
(setq pts (cons (polar pt ang1 (cdar mldata)) pts) 
       mldata (cdr mldata) 
       ) 
) 
      (setq mldata (cdr mldata) 
     pts    (reverse pts) ;_ 一条直线段点 
     NewPts (cons pts NewPts) 
      ) 
 
      ) 
    (setq NewPts (reverse NewPts)) 
    (if DisPlayJions ;_ 显示斜接 
      (progn 
(setq p1 (caar NewPts) 
       p2 (car (last NewPts)) 
       mp (GXL-MIDPOINT p1 p2) 
       ) 
   (makeline p1 mp (car LineTypes) layer (car colors)) 
   (makeline  mp p2 (last LineTypes) layer (last colors)) 
) 
   ) 
    (if oldPts 
      (progn 
 
(setq n 0 k 0) 
(repeat (length oldpts) 
   (setq NodePts  (nth n oldpts) ;_ 上一直线结点坐标 
  nextNode (car (nth n NewPts)) ;_ 本段直线起点 
  n (1+ n) 
   ) 
   (setq NodePts (append NodePts (list nextNode))) 
   (makeline (car NodePts) (cadr NodePts) (nth k LineTypes) layer (nth k colors)) ;_ 划线 
   (setq NodePts (cddr NodePts)) 
   (while NodePts 
     (makeline (car NodePts) (cadr NodePts) (nth k LineTypes) layer (nth k colors)) ;_ 划线 
     (setq NodePts (cddr NodePts)) 
   ) 
   (setq k (1+ k)) 
     ) 
   (setq oldPts NewPts) 
) 
      (setq oldPts NewPts 
     stpts (mapcar 'car NewPts) ;_ 保存起始结点点 
     ) 
      ) 
 
    ) 
  (setq EndAng ang1) ;_ 储存终点直线方向 
  (setq endpts(mapcar 'car NewPts)) ;_ 保存起始结点 
  (if closedp 
    (progn 
 
      (apply 'mapcar (list 'makeline stpts endpts LineTypes (mapcar '(lambda(x) layer) stpts) colors)) ;_ 绘制闭合线 
      ) 
    (progn 
      (if (not DisPlayJions) ;_ 不显示斜接 
(progn 
      (if (= 16 (logand dxf70 16)) ;_ 16 = 开始矩形结束（直线）封口 
(progn 
   (if (> (length stpts) 1) 
     (progn 
       (makeline (car stpts) (last stpts) "BYLAYER" layer 256) 
       ) 
     ) 
   ) 
) 
      (if (= 256 (logand dxf70 256)) ;_ 256 = 结束矩形（直线）封口 
(progn 
   (if (> (length endpts) 1) 
     (progn 
       (makeline (car endpts) (last endpts) "BYLAYER" layer 256) 
       ) 
     ) 
   ) 
) 
      ) 
) 
      (if (= 64 (logand dxf70 64)) ;_ 64 = 开始圆（外弧）封口 
(progn 
   (setq tmppt stpts tmpcolors colors tmpltypes LineTypes) 
   (setq p1 (car tmppt) ;_ 弧端点 
      p2 (last tmppt) ;_ 弧端点 
      cp (GXL-MIDPOINT p1 p2) ;_ 圆心点 
      mp (polar cp StartAng (- (distance cp p1))) ;_ 圆弧中点 
      ) 
       (makeArc cp p1 mp (car tmpltypes) layer (car tmpcolors)) 
       (makeArc cp  mp p2 (car tmpltypes) layer (last tmpcolors)) 
   ) 
) 
      (if (= 32 (logand dxf70 32)) ;_ 32 = 开始内弧封口 
(progn 
   (setq tmppt stpts tmpcolors colors tmpltypes LineTypes) 
   (setq tmppt (reverse (cdr (reverse (cdr tmppt))))) 
     (setq tmpcolors (reverse (cdr (reverse (cdr tmpcolors))))) 
     (setq tmpltypes (reverse (cdr (reverse (cdr tmpltypes))))) 
   (while (> (length tmppt) 1) 
       (setq p1 (car tmppt) ;_ 弧端点 
      p2 (last tmppt) ;_ 弧端点 
      cp (GXL-MIDPOINT p1 p2) ;_ 圆心点 
      mp (polar cp StartAng (- (distance cp p1))) ;_ 圆弧中点 
      ) 
       (makeArc cp p1 mp (car tmpltypes) layer (car tmpcolors)) 
       (makeArc cp  mp p2 (car tmpltypes) layer (last tmpcolors)) 
     (setq tmppt (reverse (cdr (reverse (cdr tmppt))))) 
     (setq tmpcolors (reverse (cdr (reverse (cdr tmpcolors))))) 
     (setq tmpltypes (reverse (cdr (reverse (cdr tmpltypes))))) 
     ) 
   ) 
) 
 
      (if (= 1024 (logand dxf70 1024)) ;_ 1024 = 结束圆（外弧）封口 
(progn 
   (setq tmppt endpts tmpcolors colors tmpltypes LineTypes) 
   (setq p1 (car tmppt) ;_ 弧端点 
      p2 (last tmppt) ;_ 弧端点 
      cp (GXL-MIDPOINT p1 p2) ;_ 圆心点 
      mp (polar cp EndAng (distance cp p1)) ;_ 圆弧中点 
      ) 
       (makeArc cp  mp p1 (car tmpltypes) layer (car tmpcolors)) 
       (makeArc cp  p2 mp  (car tmpltypes) layer (last tmpcolors)) 
   ) 
) 
      (if (= 512 (logand dxf70 512)) ;_ 512 = 结束内弧封口 
(progn 
   (setq tmppt endpts tmpcolors colors tmpltypes LineTypes) 
   (setq tmppt (reverse (cdr (reverse (cdr tmppt))))) 
     (setq tmpcolors (reverse (cdr (reverse (cdr tmpcolors))))) 
     (setq tmpltypes (reverse (cdr (reverse (cdr tmpltypes))))) 
   (while (> (length tmppt) 1) 
       (setq p1 (car tmppt) ;_ 弧端点 
      p2 (last tmppt) ;_ 弧端点 
      cp (GXL-MIDPOINT p1 p2) ;_ 圆心点 
      mp (polar cp EndAng (distance cp p1)) ;_ 圆弧中点 
      ) 
       (makeArc cp  mp p1 (car tmpltypes) layer (car tmpcolors)) 
       (makeArc cp  p2 mp  (car tmpltypes) layer (last tmpcolors)) 
     (setq tmppt (reverse (cdr (reverse (cdr tmppt))))) 
     (setq tmpcolors (reverse (cdr (reverse (cdr tmpcolors))))) 
     (setq tmpltypes (reverse (cdr (reverse (cdr tmpltypes))))) 
     ) 
   ) 
) 
      ) 
    ) 
  (entdel mline) ;_ 删除多线 
  (GXL-SEL-ENTNEXTALL EndEntity) ;_ 返回选择直线集 
  ) 
(defun c:tt5 () 
  (princ "\n***多线转直线，请选择多线: ") 
  (setq ss (ssget ":L" '((0 . "mline")))) 
  (GXL-SEL-MAPCAR ss 'GXL-ML2LINE) 
  (princ) 
  )

weiqi · 发表于 2013-1-19 00:40:52

(defun c:xxx()
(setq zm (entget(entlast))) ;;获取组码
(setq zmcd (length zm));;获取组码
(print zmcd)
(while (assoc 11 zm)
(setq p0 (cdr(assoc 11 zm)))
(print p0)
　 (setq zm (cdr (member (assoc 11 zm) zm)))
(command "pline" p0 (cdr(assoc 11 zm)) "")
)
(print )
)

错误一堆~~~。

每次获得的点，P0 怎么组成一个表噢。。。

我在WHILE 中用（SETQ jd (list jd P0））不行噢。。

用cons append 貌似也性行噢？

得怎么写呢

weiqi · 发表于 2013-1-19 00:58:56

本帖最后由 weiqi 于 2013-1-19 02:34 编辑

终于研究出来了。(setq jd (append (list p0) jd))

jd为每次的集合，
P0为每次获得的点~~~

得到顶点集格式为~

((2719.53 870.875 0.0) (2163.59 246.162 0.0) (1869.03 746.76 0.0))

账号		自动登录	找回密码
密码			注册

求MLINE线转PLINE线[已解决]

本帖子中包含更多资源

本帖子中包含更多资源

本帖子中包含更多资源