Lisp版

```

;;;图形分解《 EEXP 》;目前支持：直线、多段线、圆弧、圆！ by 忘霄-702099480@qq.com！（2018.12.6） ;;;将虚线分解成线段 V1.3（2018.12.28）优化随层虚线的分解！ ;;;将虚线分解成线段 V1.4（2020.8.8）优化随层虚线的分解:将ByLayer改为BYLAYER，修补图层曲线不能分解的bug！

(defun c:eexp(/ ent entss i obj objlst objname zxfj) ;;说明:图元分类分解 ;;参数:obj:图形对象 ;;参数:objname:图形obj类型 (defun curfj(obj objname / ang cpt crdis crlen eang ept llen lsac ltp ltpdis ltplen ltplst meang mept mkarc mkcir mkline msang n rad sang slen spt) (defun mkline(ang ept ltpdis ltplen n obj slen spt / mept mspt) (entmake (list ‘(0 . “LINE”) (cons 10 spt) (cons 11 (setq mept (polar spt ang (/ slen 2.0)))))) (repeat n (entmake (list ‘(0 . “LINE”) (cons 10 (setq mspt (polar mept ang ltpdis))) (cons 11 (setq mept (polar mspt ang ltplen))))) ) (entmake (list ‘(0 . “LINE”) (cons 10 (polar mept ang ltpdis)) (cons 11 ept))) (vla-Delete obj) ) (defun mkArc(cpt eang ept llen ltpdis ltplen n obj rad sang slen spt / meang msang) (entmake (list ‘(0 . “ARC”) (cons 10 cpt) (cons 40 rad) (cons 50 sang) (cons 51 (setq meang (+ sang ( (/ (/ slen 2.0) llen) (- eang sang))))))) (repeat n (entmake (list ‘(0 . “ARC”) (cons 10 cpt) (cons 40 rad) (cons 50 (setq msang (+ meang ( (/ ltpdis llen) (- eang sang))))) (cons 51 (setq meang (+ msang ( (/ ltplen llen) (- eang sang))))))) ) (entmake (list ‘(0 . “ARC”) (cons 10 cpt) (cons 40 rad) (cons 50 (setq msang (+ meang ( (/ ltpdis llen) (- eang sang))))) (cons 51 eang))) (vla-Delete obj) ) (defun mkcir(cpt crdis crlen eang llen n obj rad sang / meang msang) (entmake (list ‘(0 . “ARC”) (cons 10 cpt) (cons 40 rad) (cons 50 sang) (cons 51 (setq meang (+ sang ( (/ crlen llen) (- eang sang))))))) (repeat n (entmake (list ‘(0 . “ARC”) (cons 10 cpt) (cons 40 rad) (cons 50 (setq msang (+ meang ( (/ crdis llen) (- eang sang))))) (cons 51 (setq meang (+ msang ( (/ crlen llen) (- eang sang))))))) ) (vla-Delete obj) ) (cond ((= objname “AcDbLine”) (setq spt (vlax-safearray->list (vlax-variant-value (vla-get-StartPoint obj))) ept (vlax-safearray->list (vlax-variant-value (vla-get-EndPoint obj))) ang (vla-get-Angle obj) llen (vla-get-Length obj) ) ) ((= objname “AcDbArc”) (setq cpt (vlax-safearray->list (vlax-variant-value (vla-get-Center obj))) spt (vlax-safearray->list (vlax-variant-value (vla-get-StartPoint obj))) ept (vlax-safearray->list (vlax-variant-value (vla-get-EndPoint obj))) sang (vla-get-StartAngle obj) eang (vla-get-EndAngle obj) llen (vla-get-ArcLength obj) rad (vla-get-Radius obj) ) (if (> sang eang) (setq sang (- sang ( pi 2))) ) ) ((= objname “AcDbCircle”) (setq cpt (vlax-safearray->list (vlax-variant-value (vla-get-Center obj))) llen (vla-get-Circumference obj) rad (vla-get-Radius obj) sang 0 eang ( pi 2) ) ) ) (if (= (vla-get-Linetype obj) “BYLAYER”) (setq lay (vla-get-Layer obj) ltp (Vla-Get-Linetype (vla-Item (Vla-Get-Layers (Vla-Get-ActiveDocument (Vlax-Get-Acad-Object))) lay)) lsac (vla-get-LinetypeScale obj) ltplst (entget (tblobjname “LTYPE” ltp)) ) (setq ltp (vla-get-Linetype obj) lsac (vla-get-LinetypeScale obj) ltplst (entget (tblobjname “LTYPE” ltp)) ) ) (foreach X ltplst (if (= (car x) 49) (if (> (cdr x) 0) (setq ltplen (cdr x)) (setq ltpdis (abs (cdr x))) ) ) ) (setq ltplen ( ltplen lsac) ltpdis ( ltpdis lsac) n 0) (if (> llen (+ ltplen ltpdis)) (progn (setq n (fix (/ (- llen ltpdis) (+ ltplen ltpdis)))) (if (= objname “AcDbLine”) (cond ((< (setq slen (rem (- llen ltpdis) (+ ltplen ltpdis))) ltplen) (setq n (- n 1) slen (- llen ltpdis ( (+ ltplen ltpdis) n))) (mkline ang ept ltpdis ltplen n obj slen spt) ) (T (if (= n 0) (progn (entmake (list ‘(0 . “LINE”) (cons 10 spt) (cons 11 (setq mept (polar spt ang (/ (- llen ltpdis) 2.0)))))) (entmake (list ‘(0 . “LINE”) (cons 10 (polar mept ang ltpdis)) (cons 11 ept))) (vla-Delete obj) ) (mkline ang ept ltpdis ltplen n obj slen spt) ) ) ) ) (if (= objname “AcDbArc”) (cond ((<= (setq slen (rem (- llen ltpdis) (+ ltplen ltpdis))) ltplen) (setq n (- n 1) slen (- llen ltpdis ( (+ ltplen ltpdis) n))) (mkArc cpt eang ept llen ltpdis ltplen n obj rad sang slen spt) ) (T (if (= n 0) (progn (entmake (list ‘(0 . “ARC”) (cons 10 cpt) (cons 40 rad) (cons 50 sang) (cons 51 (setq meang (+ sang ( (/ (/ (- llen ltpdis) 2.0) llen) (- eang sang))))))) (entmake (list ‘(0 . “ARC”) (cons 10 cpt) (cons 40 rad) (cons 50 (setq msang (+ meang ( (/ ltpdis llen) (- eang sang))))) (cons 51 eang))) (vla-Delete obj) ) (mkArc cpt eang ept llen ltpdis ltplen n obj rad sang slen spt) ) ) ) ) (if (= objname “AcDbCircle”) (cond ((and (<= (rem llen (+ ltplen ltpdis)) (/ (+ ltplen ltpdis) 2.0)) (> n 1)) (setq crlen ( (/ (/ llen n) (+ ltplen ltpdis)) ltplen) crdis ( (/ (/ llen n) (+ ltplen ltpdis)) ltpdis) n (- n 1)) (mkcir cpt crdis crlen eang llen n obj rad sang) ) (T (setq crlen ( (/ (/ llen (+ n 1)) (+ ltplen ltpdis)) ltplen) crdis (* (/ (/ llen (+ n 1)) (+ ltplen ltpdis)) ltpdis)) (mkcir cpt crdis crlen eang llen n obj rad sang) ) ) ) ) (progn (if (= objname “AcDbLine”) (progn (entmake (list ‘(0 . “LINE”) (cons 10 spt) (cons 11 ept))) (vla-Delete obj) ) ) ) ) (princ) ) (princ “\n请选择需处理的虚线图元：”) (setq entss (ssget ‘((0 . “LINE,LWPOLYLINE,CIRCLE,ARC”))) i 0) (while (setq ent (ssname entss i)) (setq obj (vlax-ename->vla-object ent) objname (vla-get-ObjectName obj)) (cond ((or (= objname “AcDbLine”) (= objname “AcDbArc”) (= objname “AcDbCircle”) ) (curfj obj objname) ) ((= objname “AcDbPolyline”) (setq objlst (vlax-safearray->list (vlax-variant-value (vla-explode obj)))) (vla-Delete obj) (foreach x objlst (curfj x (vla-get-ObjectName x))) ) ) (setq i (+ i 1)) ) (princ (strcat “\n处理完成，共处理了” (itoa i) “个图元！”)) (princ) ) (princ “\n图形分解《 EEXP 》;目前支持：直线、多段线、圆弧、圆！ by 忘霄-702099480@qq.com！”) (princ)

  1. ![将虚线分解成段线.gif](https://cdn.nlark.com/yuque/0/2020/gif/586817/1605158188480-a2e31bc8-e1c5-44d1-b0de-e562664b9f75.gif#align=left&display=inline&height=749&margin=%5Bobject%20Object%5D&name=%E5%B0%86%E8%99%9A%E7%BA%BF%E5%88%86%E8%A7%A3%E6%88%90%E6%AE%B5%E7%BA%BF.gif&originHeight=749&originWidth=1176&size=1421751&status=done&style=none&width=1176)
  2. WMF版：

(defun c:XXFJ(/ blname entnam entnam2 i ltpoint num pixelsize ptlist ss tempfil viewcenter viewheigh) (setvar “CMDECHO” 0) (princ “\n请选取要分解为线段的虚线：”) (setq ss (ssget ‘((0 . “LINE,POLYLINE,LWPOLYLINE,CIRCLE,ARC,ELLIPSE,SPLINE”)))) (if ss (progn (setq i 0 num (sslength ss)) (repeat num (setq entnam (ssname ss i)) (command “zoom” “o” entnam “”) (setq PixelSize (getvar “screensize”);以像素为单位读取当前视口大小（X 和 Y） ViewHeigh (getvar “viewsize”);以图形单位测量当前视口中显示的视图的高度 ViewCenter (getvar “viewctr”) ;以UCS坐标表示当前视口中的视图的中心 PtList (list (list (- (car ViewCenter) ( 0.5 ( ViewHeigh (/ (car PixelSize) (cadr PixelSize))))) (- (cadr ViewCenter) ( 0.5 ViewHeigh)) );视窗区左下角的坐标点 (list (+ (car ViewCenter) ( 0.5 ( ViewHeigh (/ (car PixelSize) (cadr PixelSize))))) (+ (cadr ViewCenter) ( 0.5 ViewHeigh)) );视窗区右上角的坐标点 ) LTPoint (list (caar PtList) ;视窗区左下角的X坐标 (cadadr PtList) ;视窗区右上角的Y坐标 ) ) (setq TempFil (strcat (getenv “Temp”) “\textb.wmf”)) (command “wmfout” TempFil entnam “” “erase” entnam “” “wmfin” TempFil LTPoint “2.0” “” “” ) (setq entnam2 (vlax-ename->vla-object (entlast)) blname (vla-get-Name entnam2)) (vla-explode entnam2) (vla-delete entnam2) (Vla-Delete (vla-Item (Vla-Get-Blocks (Vla-Get-ActiveDocument (Vlax-Get-Acad-Object))) blname)) (setq i (1+ i)) (command “zoom” “p”) (vl-file-delete TempFil) ) (princ (strcat “\n共分解了” (itoa num) “条虚线！”)) ) (princ “\n提示：未选中虚线，程序退出!”) ) (princ) ) (princ “\n分解虚线为线段《 XXFJ 》”) (princ) ```