设为首页收藏本站CAD论坛CAD教程CAD下载明经币充值
切换到宽版

明经CAD社区

 找回密码
 注册

QQ登录

只需一步，快速开始

搜索
明经CAD社区»社区 › 开发篇 › AutoLISP/Visual LISP 编程技术 › 把上回龙仔贴的3DPOLY 的offset改了一下,
返回列表 发新帖
查看: 1804|回复: 1

把上回龙仔贴的3DPOLY 的offset改了一下,

[复制链接]
luoyaya
发表于 2003-12-20 11:05:00 | 显示全部楼层 |阅读模式
这是原来的:
  2. ;;Tip1877:       3D_OFFSET.LSP    3D PLINE OFFSET   (c) 2003 Silvia Soonets
  3. (vl-load-com)
  4. (setq ESTEDIBUJO (vla-get-activedocument (vlax-get-acad-object)))
  5. (setq *MODELSPACE* (vla-get-modelspace ESTEDIBUJO))
  6. (defun C:3D_OFFSET (/     ENAME   OBJECT  LISTA   LISTA1  X
  7.       N     DISTA   OBJECT1 ENAME1  LAY     COL
  8.       LTYPE   LTS     LW     LISTAZ  NVER
  9.      )
  10.   (setq DISTA (getdist (strcat "\nSpecify offset distance <"
  11.           (rtos (getvar "OFFSETDIST") 2 2)
  12.           "> :"
  13.          )
  14.        )
  15.   )
  16.   (if (not DISTA)
  17.     (setq DISTA (getvar "OFFSETDIST"))
  18.   )
  19.   (setq ENAME (entsel "\nSelect 3dpoly to offset or <exit>: "))
  20.   (while ENAME
  21.     (setq ENAME  (car ENAME)
  22.    OBJECT (vlax-ename->vla-object ENAME)
  23.     )
  24.     (if (= (vlax-get-property OBJECT "ObjectName") "AcDb3dPolyline")
  25.       (progn
  26. (setq LAY (vlax-get-property OBJECT "Layer")
  27.        LTYPE (vlax-get-property OBJECT "Linetype")
  28.        COL (vlax-get-property OBJECT "Color")
  29.        LTS (vlax-get-property OBJECT "LinetypeScale")
  30.        LW (vlax-get-property OBJECT "Lineweight")
  31.        IS_CLOSED (vlax-get-property OBJECT "Closed")
  32.        LISTA (vlax-get-property OBJECT "Coordinates")
  33.        LISTA (vlax-safearray->list (vlax-variant-value LISTA))
  34.        N  0
  35.        LISTA1 NIL
  36. )
  37. (while (setq X (nth N LISTA))
  38.    (setq NVER   (/ (length LISTA) 3.00)
  39.   LISTA1 (append LISTA1 (list X))
  40.   X      (nth (1+ N) LISTA)
  41.   LISTA1 (append LISTA1 (list X))
  42.   LISTAZ (append LISTAZ (list (nth (+ 2 N) LISTA)))
  43.   N      (+ 3 N)
  44.    )
  45. )
  46. (setq PT (getpoint "\nSpecify point on side to offset?: "))
  47. (setq N      (1- (length LISTA1))
  48.        LISTA1 (vlax-safearray-fill
  49.          (vlax-make-safearray vlax-vbdouble (cons 0 N))
  50.          LISTA1
  51.        )
  52.        OBJECT (vla-addlightweightpolyline *MODELSPACE* LISTA1)
  53.        ENAME  (vlax-vla-object->ename OBJECT)
  54. )
  55. (command "offset" DISTA ENAME PT "")
  56. (setq OBJECT1 (vlax-ename->vla-object (entlast)))
  57. (vlax-put-property OBJECT1 "Closed" IS_CLOSED)
  58. (setq LISTA1 (vlax-safearray->list
  59.          (vlax-variant-value
  60.     (vlax-get-property OBJECT1 "Coordinates")
  61.          )
  62.        )
  63.        N      0
  64.        LISTA  NIL
  65. )
  66. (entdel ENAME)
  67. (if (= (/ (length LISTA1) 2) NVER)
  68.    (progn
  69.      (while (setq X (nth N LISTA1))
  70.        (setq LISTA (append LISTA (list X))
  71.       LISTA (append LISTA (list (nth (1+ N) LISTA1)))
  72.       LISTA (append LISTA (list (nth (/ N 2) LISTAZ)))
  73.       N   (+ 2 N)
  74.        )
  75.      )
  76.      (setq N  (1- (length LISTA))
  77.     LISTA  (vlax-safearray-fill
  78.       (vlax-make-safearray vlax-vbdouble (cons 0 N))
  79.       LISTA
  80.     )
  81.     OBJECT (vla-add3dpoly *MODELSPACE* LISTA)
  82.     ENAME  (vlax-vla-object->ename OBJECT1)
  83.      )
  84.      (entdel ENAME)
  85.      (vlax-put-property OBJECT "Closed" IS_CLOSED)
  86.      (vlax-put-property OBJECT "Layer" LAY)
  87.      (vlax-put-property OBJECT "Linetype" LTYPE)
  88.      (vlax-put-property OBJECT "Color" COL)
  89.      (vlax-put-property OBJECT "LinetypeScale" LTS)
  90.      (vlax-put-property OBJECT "Lineweight" LW)
  91.    )
  92.    (prompt
  93.      "\nThe number of vertices have to change. Cannot 3d_offset that object"
  94.    )
  95. )
  96.       )
  97.       (prompt "\nCannot 3d_offset that object")
  98.     )
  99.     (setq ENAME (entsel "\nSelect 3dpoly to offset or <exit>: "))
  100.   )
  101.   (princ)
  102. )

这是我改过的:改过之后不会应该OFFSET的点变少了而不出错

  3. Tip1877:       3D_OFFSET.LSP    3D PLINE OFFSET   (c) 2003 Silvia Soonets;luoyaya重新修改
  4. (vl-load-com)
  5. (setq *VLA-ACDOC* (vla-get-activedocument (vlax-get-acad-object)))
  6. (setq *MODELSPACE* (vla-get-modelspace *VLA-ACDOC*))

  8.     (defun pointtolinedist (plin1 plin2 point / xdist ang)
  9.       (setq xdist (distance plin1 point))
  10.       (setq ang (abs (- (angle plin1 point) (angle plin1 plin2))))
  11.       (* (sin ang) xdist)
  12.     )
  13. (defun C:3o (/     ENAME   OBJECT  LISTA   LISTA1  X
  14.       N     DISTA   OBJECT1 ENAME1  LAY     COL
  15.       LTYPE   LTS     LW     LISTAZ  NVER
  16.              LISTB1 NB
  17.      )
  18.   (setq DISTA (getdist (strcat "\n输入offset距离<"
  19.           (rtos (getvar "OFFSETDIST") 2 2)
  20.           ">:"
  21.          )
  22.        )
  23.   )
  24.   (if (not DISTA)
  25.     (setq DISTA (getvar "OFFSETDIST"))
  26.   )
  27.   (setq ENAME (entsel "\n点取一条3dpoly或<退出>: "))
  28.   (while ENAME
  29.     (setq ENAME  (car ENAME)
  30.    OBJECT (vlax-ename->vla-object ENAME)
  31.           n nil
  32.           lista nil
  33.           lista1 nil
  34.           listb1 nil
  35.           listaz nil
  36.           nver nil
  37.           
  38.     )
  39.     (if (= (vlax-get-property OBJECT "ObjectName") "AcDb3dPolyline")
  40.       (progn
  41. (setq LAY (vlax-get-property OBJECT "Layer")
  42.        LTYPE (vlax-get-property OBJECT "Linetype")
  43.        COL (vlax-get-property OBJECT "Color")
  44.        LTS (vlax-get-property OBJECT "LinetypeScale")
  45.        LW (vlax-get-property OBJECT "Lineweight")
  46.        IS_CLOSED (vlax-get-property OBJECT "Closed")
  47.        LISTA (vlax-get-property OBJECT "Coordinates")
  48.        LISTA (vlax-safearray->list (vlax-variant-value LISTA))
  49.        N  0
  50.        LISTA1 NIL
  51. )
  52. (while (setq X (nth N LISTA))
  53.    (setq NVER   (/ (length LISTA) 3.00)
  54.   LISTA1 (append LISTA1 (list X))
  55.   X      (nth (1+ N) LISTA)
  56.   LISTA1 (append LISTA1 (list X))
  57.   LISTAZ (append LISTAZ (list (nth (+ 2 N) LISTA)))
  58.   N      (+ 3 N)
  59.    )
  60. )
  61.   ;修改原变量
  62. (setq LISTB1 LISTA1)

  64. (setq PT (getpoint "\noffset到哪边: "))

  66. (setq N      (1- (length LISTA1))
  67.        LISTA1 (vlax-safearray-fill
  68.          (vlax-make-safearray vlax-vbdouble (cons 0 N))
  69.          LISTA1
  70.        )
  71.        OBJECT (vla-addlightweightpolyline *MODELSPACE* LISTA1)
  72.        ENAME  (vlax-vla-object->ename OBJECT)
  73. )

  75. (command "offset" DISTA ENAME PT "")
  76. (setq OBJECT1 (vlax-ename->vla-object (entlast)))
  77. (vlax-put-property OBJECT1 "Closed" IS_CLOSED)
  78. (setq LISTA1 (vlax-safearray->list
  79.          (vlax-variant-value
  80.     (vlax-get-property OBJECT1 "Coordinates")
  81.          )
  82.        )
  83.        N      0
  84.        LISTA  NIL
  85. )
  86. (entdel ENAME)
  87. (if (= (/ (length LISTA1) 2) NVER);比较点个数
  88.    (progn
  89.      (while (setq X (nth N LISTA1))
  90.        (setq LISTA (append LISTA (list X))
  91.       LISTA (append LISTA (list (nth (1+ N) LISTA1)))
  92.       LISTA (append LISTA (list (nth (/ N 2) LISTAZ)))
  93.       N   (+ 2 N)
  94.        )
  95.      )
  96.      (setq N  (1- (length LISTA))
  97.     LISTA  (vlax-safearray-fill
  98.       (vlax-make-safearray vlax-vbdouble (cons 0 N))
  99.       LISTA
  100.     )
  101.     OBJECT (vla-add3dpoly *MODELSPACE* LISTA)
  102.     ENAME  (vlax-vla-object->ename OBJECT1)
  103.      )
  104.      (entdel ENAME)
  105.      (vlax-put-property OBJECT "Closed" IS_CLOSED)
  106.      (vlax-put-property OBJECT "Layer" LAY)
  107.      (vlax-put-property OBJECT "Linetype" LTYPE)
  108.      (vlax-put-property OBJECT "Color" COL)
  109.      (vlax-put-property OBJECT "LinetypeScale" LTS)
  110.      (vlax-put-property OBJECT "Lineweight" LW)
  111.    )


  114.    ;LISTB1为原线点坐标表
  115.    ;LISTA1为新线点坐标表
  116.    ;新变量: LISTB1 NB
  117.    (progn
  118.      (setq LISTA (list (car LISTA1) (cadr LISTA1) (car LISTAZ))
  119.            n 2
  120.            NB 2
  121.            lenb (length LISTB1))
  122.      (while (setq X (nth N LISTA1))
  123.        (while (and (not (equal  (pointtolinedist
  124.                      (list (nth (- NB 2) LISTB1) (nth (1- NB) LISTB1))
  125.                      (list (nth NB LISTB1) (nth (1+ NB) LISTB1))
  126.                      (list x (nth (1+ N) LISTA1))
  127.                      )
  128.                     DISTA 1)) (< NB lenb))
  129.          (setq NB (+ 2 NB))
  130.          )
  131.        (if (< NB lenb)
  132.          (setq LISTA (append LISTA (list X))
  133.                LISTA (append LISTA (list (nth (1+ N) LISTA1)))
  134.                LISTA (append LISTA (list (nth (/ NB 2) LISTAZ)))
  135.          )
  136.          (setq LISTA (append LISTA (list X))
  137.                LISTA (append LISTA (list (nth (1+ N) LISTA1)))
  138.                LISTA (append LISTA (list (nth (/ N 2) LISTAZ)))
  139.          )
  140.        )
  141.        (setq  N (+ 2 N)
  142.               NB n)
  143.      )
  144.      (setq N  (1- (length LISTA))
  145.     LISTA  (vlax-safearray-fill
  146.       (vlax-make-safearray vlax-vbdouble (cons 0 N))
  147.       LISTA
  148.     )
  149.     OBJECT (vla-add3dpoly *MODELSPACE* LISTA)
  150.     ENAME  (vlax-vla-object->ename OBJECT1)
  151.      )
  152.      (entdel ENAME)
  153.      (vlax-put-property OBJECT "Closed" IS_CLOSED)
  154.      (vlax-put-property OBJECT "Layer" LAY)
  155.      (vlax-put-property OBJECT "Linetype" LTYPE)
  156.      (vlax-put-property OBJECT "Color" COL)
  157.      (vlax-put-property OBJECT "LinetypeScale" LTS)
  158.      (vlax-put-property OBJECT "Lineweight" LW)
  159.    )
  160.    ;(prompt     "\n该对象顶点数改变. 不能再offset该对象"   )
  161. )
  162.       )
  163.       (prompt "\n不能offset该对象!")
  164.     )
  165.     (setq ENAME (entsel "\n点取一条3dpoly或<退出>:"))
  166.   )
  167.   (princ)
  168. )

回复

使用道具 举报

hisum
发表于 2014-5-10 17:38:35 | 显示全部楼层
运行出错啊，大神
回复 支持 反对

使用道具 举报

返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码，在未取得本站及作者授权的情况下，不得用于商业用途

GMT+8, 2025-5-24 20:04 , Processed in 0.190050 second(s), 25 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表