明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 5394|回复: 13

[源码] 强力Z坐标归零! 210组码问题还未解决

  [复制链接]
发表于 2014-10-20 13:25 | 显示全部楼层 |阅读模式
升级了下我的Z值归零程序,增加了对原来不敢碰的面域,块定义的处理,但是法向非Z轴对齐的对象还有问题。

G版的correct210 函数 在我这里报“; 错误: Automation 错误。 不能按非统一比例缩放”,所以210段修正功能暂时屏蔽,静待高人解决。

http://bbs.mjtd.com/forum.php?mod=viewthread&tid=110013贴中的“要归零的.dwg”已经90%可以处理了。剩下椭圆、210问题未解决。

correct210 源贴:
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=93123


  1. (vl-load-com)

  2. (defun getboundingbox (ename / lb ur)
  3.   (vla-getboundingbox
  4.     (vlax-ename->vla-object ename)
  5.     'lb
  6.     'ur
  7.   )
  8.   (mapcar 'vlax-safearray->list (list lb ur))
  9. )
  10. ;;


  11. (defun move-region-to-wcs-plan (ename / obj z)
  12.   (setq obj (vlax-ename->vla-object ename))
  13.   (if (and
  14.   (= "AcDbRegion" (vla-get-objectname obj))
  15.   (/= 0.0 (setq z (caddr (car (getboundingbox ename)))))
  16.       )
  17.     (vla-move obj
  18.         (vlax-3d-point (list 0 0 z))
  19.         (vlax-3d-point (list 0 0 0))
  20.     )
  21.   )
  22. )
  23. ;; (move-region-to-wcs-plan(car(entsel)))


  24. ;; http://bbs.mjtd.com/thread-93123-1-1.html
  25. (defun correct210 (ent / obj za)
  26.   (setq obj (vlax-ename->vla-object ent))
  27.   (if (and (vlax-property-available-p obj 'normal t)
  28.      (not  (equal '(0 0 1)
  29.            (setq za  (vlax-safearray->list
  30.           (vlax-variant-value (vla-get-normal obj))
  31.         )
  32.            )
  33.     )
  34.      )
  35.       )
  36.     (vl-catch-all-apply 'vla-put-normal (list obj (vlax-3d-point '(0 0 1))))
  37. ;;;    (progn
  38. ;;;      (setq za (vlax-safearray->list
  39. ;;;     (vlax-variant-value (vla-get-normal obj))
  40. ;;;         )
  41. ;;;      )
  42. ;;;      (vla-transformby
  43. ;;;  obj
  44. ;;;  (vlax-tmatrix
  45. ;;;    (list
  46. ;;;      (list 1 0 (car za) 0)
  47. ;;;      (list 0 1 (cadr za) 0)
  48. ;;;      (list 0 0 (caddr za) 0)
  49. ;;;      (list 0 0 0 1)
  50. ;;;    )
  51. ;;;  )
  52. ;;;      )
  53. ;;;    )
  54.   )
  55. )
  56. ;;

  57. (defun zero-group (e)
  58.   (cond
  59.     ;; 处理 10-14 段,含 Z 坐标且非零组码,设置Z = 0.0
  60.     ((and (>= (car e) 10)
  61.     (<= (car e) 14)
  62.     (> (length e) 3)
  63.     (/= 0.0 (nth 3 e))
  64.      )
  65.      (setq c10 (1+ c10))
  66.      (cons (car e) (list (cadr e) (caddr e) 0.0))
  67.     )

  68.     ;; 处理 38 段(标高属性)
  69.     ((and (= (car e) 38) (/= 0.0 (cdr e)))
  70.      (setq c38 (1+ c38))
  71.      '(38 . 0.0)
  72.     )

  73.     ;; 其余组码原样返回
  74.     (t e)
  75.   )
  76. )

  77. (defun zero-ent  (e / dxf new)
  78.   ;;(correct210 e)

  79.   (setq dxf (entget e))

  80.   (if (= (cdr (assoc 0 dxf)) "REGION")
  81.     (move-region-to-wcs-plan e)

  82.     (progn
  83.       (setq new (mapcar 'zero-group dxf))
  84.       (if (not (equal dxf new))
  85.   (entmod new)
  86.       )
  87.     )
  88.   )
  89.   new
  90. )

  91. (defun zero-block (/)
  92.   (vlax-for block (vla-get-blocks
  93.         (vla-get-activedocument (vlax-get-acad-object))
  94.       )
  95.     (vlax-for e  block
  96.       (zero-ent (vlax-vla-object->ename e))
  97.     )
  98.   )
  99. )


  100. (defun c:zeroz (/ c10 c38 dxf ent i len ss)
  101.   (princ "选择需要将Z坐标或标高属性清零的对象 <回车选择所有图元>: ")
  102.   
  103.   (setq ss (ssget))
  104.   (if (null ss)
  105.     (setq ss (ssget "_X"))
  106.   )
  107.   (if (null ss)
  108.     (progn (princ "\n选择集空")
  109.      (quit)
  110.     )
  111.   )

  112.   (setq  len (sslength ss)
  113.   i   0
  114.   c10 0
  115.   c38 0
  116.   )

  117.   (vla-startundomark
  118.     (vla-get-activedocument (vlax-get-acad-object))
  119.   )

  120.   ;; 块定义内实体归零
  121.   (zero-block)

  122.   (repeat len

  123.     (zero-ent (setq ent (ssname ss i)))

  124. ;;;      ((wcmatch (cdr (assoc 0 dxf)) "INSERT,POLYLINE")
  125. ;;;       (setq ent (entnext ent))
  126. ;;;      
  127. ;;;       (while (and ent
  128. ;;;       (setq et (cdr (assoc 0 (setq dxf (entget ent)))))
  129. ;;;       (= et "ATTDEF")
  130. ;;;       (/= et "SEQEND")
  131. ;;;        )
  132. ;;;   (zero-ent ent)
  133. ;;;   (setq ent (entnext ent))
  134. ;;;       )
  135. ;;;      )
  136.     (setq i (1+ i))
  137.   )


  138.   (vla-endundomark
  139.     (vla-get-activedocument (vlax-get-acad-object))
  140.   )

  141.   (command "_.regen")

  142.   (princ (strcat "选择的 "
  143.      (itoa len)
  144.      " 个对象中,\n"
  145.      (itoa c10)
  146.      " 个非零Z坐标, "
  147.      (itoa c38)
  148.      " 个标高属性被强制清零."
  149.    )
  150.   )
  151.   (princ)
  152. )

评分

参与人数 3明经币 +3 收起 理由
自贡黄明儒 + 1 很给力!
USER2128 + 1 赞一个!
lucas_3333 + 1 神马都是浮云

查看全部评分

"觉得好,就打赏"
还没有人打赏,支持一下

本帖被以下淘专辑推荐:

发表于 2021-6-12 06:48 | 显示全部楼层
本帖最后由 KO你 于 2021-6-12 08:26 编辑

大佬,有些内嵌动态块的属性字没能归零,能加上这个吗
(setvar "cmdecho" 0)
(command "_.UCS" "")
(command "_.move" "_all" "" '(0 0 1e99) "" "_.move" "_p" "" '(0 0 -1e99) "")
(setvar "cmdecho" 1)
(princ)
)end
发表于 2021-6-12 12:45 | 显示全部楼层
我想知道到 210组码是啥意思 看不懂
DXF:拉伸方向的 X 值

APP:三维拉伸方向矢量
这个  比如说一个 三维圆  (10 0 0 0)(40 5)(210 0.46 -0.22 0.86)这个 210组码是啥意思
发表于 2014-10-20 13:35 | 显示全部楼层
抢座支持!!!
发表于 2014-10-20 15:04 | 显示全部楼层
强力支持!!
发表于 2014-10-20 15:45 | 显示全部楼层
支持楼主继续研究
发表于 2014-10-20 15:56 | 显示全部楼层
Z值归零程序,不能按非统一比例缩放,到底什么关系?是什么错误?楼主给大家讲讲吧!

点评

麻烦看下这个帖子,问题一直没解决,谢谢啦, http://bbs.mjtd.com/thread-168630-1-1.html  发表于 2016-1-15 17:38
我也在静待高人解决呢,没这水平讲啊~~  发表于 2014-10-20 16:26
发表于 2016-1-7 10:03 | 显示全部楼层
这个代码怎么用呢, 能存成lsp格式直接用吗

点评

另存为lsp文件,运行zeroz  发表于 2016-1-7 11:58
发表于 2016-1-7 11:55 | 显示全部楼层
期待楼主解决非(210 0 0 1)的Z轴变零。
发表于 2016-1-14 00:28 | 显示全部楼层
十分感谢, 但是这个代码里有好多 defun +**** 字符, 一般来说defun后面就是快捷键对吗 ? (我是外行)
发表于 2016-1-14 00:32 | 显示全部楼层
研究了一下, 貌似是 defun c:后的字符才是快捷键吧,但我就很好奇, 做编程的也画cad吗? 你们也画施工图?
发表于 2016-1-14 08:33 | 显示全部楼层
谢谢,挺实用的程序!
您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2024-3-29 10:05 , Processed in 0.232919 second(s), 36 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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