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

明经CAD社区

 找回密码
 注册

QQ登录

只需一步，快速开始

搜索
明经CAD社区»社区 › 开发篇 › AutoLISP/Visual LISP 编程技术 › 消隐、遮罩 基础程序
返回列表 发新帖
查看: 1221|回复: 2

[源码] 消隐、遮罩 基础程序

  [复制链接]
345205680
发表于 2021-12-22 22:04:37 | 显示全部楼层 |阅读模式
  2. (defun c:tt (/ s1 i a1 txt pt1 txtbox x y pt2 pt3);高程点消隐
  3.   (princ "\n请选择高程点:")
  4.   (setq s1 (ssget  '((0 . "INSERT")(2 . "gc200"))))
  5.   (if s1
  6.     (progn
  7.       (setq i -1)
  8.       (repeat(sslength s1)
  9.         (setq a1 (ssname s1 (setq i(1+ i))))
  10.         (setq txt (entnext a1))
  11.         (setq txt (entget txt))
  12.         (if (= (cdr (assoc 0 txt)) "ATTRIB")
  13.           (progn
  14.             (setq pt1 (cdr (assoc 10 txt)))
  15.             (setq pt1 (list (car pt1) (cadr pt1)))
  16.             (setq txtbox (textbox txt))
  17.             (setq txtbox (cdr txtbox))
  18.             (setq txtbox (car txtbox))
  19.             (setq x (car txtbox))
  20.             (setq y (cadr txtbox))
  21.             (setq pt1 (polar pt1 (* 1.25 pi) 0.1414))
  22.             (setq pt2 (polar pt1 0.0 (+ x 0.2)))
  23.             (setq pt3 (polar pt2 (* 0.5 pi) (+ y 0.2)))
  24.             (setq pt4 (polar pt1 (* 0.5 pi) (+ y 0.2)))
  25.             (command "_wipeout" "f" "off")
  26.             (command "wipeout" pt1 pt2 pt3 pt4 "c")
  27.             (command "draworder" s1 "" "f")
  28.           )
  29.           (print "你选择的高程点没有属性!")
  30.         )
  31.       )
  32.     )
  33.   )
  34.   (prin1)
  35. )

  37. ;==============================================================
  38. (defun c:tt1 (/ s1 i a1 txt pt1 txtbox x y pt2 pt3);文字消隐
  39.   (princ "\n请选择文字:")
  40.   (if(setq s1 (ssget  '((0 . "text"))))
  41.     (progn
  42.       (setq i -1)
  43.       (repeat(sslength s1)
  44.         (setq e(ssname s1(setq i(1+ i))))
  45.         (setq txt (entget e))
  46.         (setq pt1 (cdr (assoc 10 txt)))
  47.         (setq pt1 (list (car pt1) (cadr pt1)))
  48.         (setq txtbox (textbox txt))
  49.         (setq txtbox (cdr txtbox))
  50.         (setq txtbox (car txtbox))
  51.         (setq x (car txtbox))
  52.         (setq y (cadr txtbox))
  53.         (setq pt1 (polar pt1 (* 1.25 pi) 0.1414))
  54.         (setq pt2 (polar pt1 0.0 (+ x 0.2)))
  55.         (setq pt3 (polar pt2 (* 0.5 pi) (+ y 0.2)))
  56.         (setq pt4 (polar pt1 (* 0.5 pi) (+ y 0.2)))
  57.         (command "_wipeout" "f" "off")
  58.         (command "wipeout" pt1 pt2 pt3 pt4 "c")
  59.         (command "draworder" s1 "" "f")
  60.       )
  61.     )
  62.   )
  63.   (prin1)
  64. )

  66. ;==============================================================块消隐
  67. (defun c:tt2 (/ s1 i e pt1 pt2 pt3 pt4)
  68.   (princ "\n请选择图块:")
  69.   (if(setq s1(ssget  '((0 . "INSERT")(8 . "dldw"))))
  70.     (progn
  71.       (setq i -1)
  72.       (repeat(sslength s1)
  73.         (Setq e(ssname s1(setq i(1+ i))))
  74.         (vla-getboundingbox (vlax-ename->vla-object e) 'pt1 'pt2)
  75.         (setq
  76.           pt1(vlax-safearray->list pt1)
  77.           pt2 (vlax-safearray->list pt2)
  78.         )
  79.         (setq pt1(list(car pt1)(cadr pt1)))
  80.         (setq pt2(list(car pt2)(cadr pt2)))
  81.         (setq pt3(list(car pt1)(cadr pt2)))
  82.         (setq pt4(list(car pt2)(cadr pt1)))
  83.         (if(< 1(sslength(ssget "_CP" (list pt1 pt3 pt2 pt4))))
  84.           (progn
  85.             (command "_wipeout" "f" "off")
  86.             (command "wipeout" "_non" pt1"_non" pt3 "_non" pt2 "_non" pt4 "c")
  87.             (command "draworder" s1 "" "f")
  88.           )
  89.         )
  90.       )
  91.     )
  92.   )
  93.   (prin1)
  94. )

  96. ;===================================================================综合消隐
  97. (defun c:tt4 (/ s1 i e pt1 pt2 pt3 pt4)
  98.   (princ "\n请选择图块:")
  99.   (if(setq s1(ssget '((0 . "~*line"))))
  100.     (progn
  101.       (setq i -1)
  102.       (repeat(sslength s1)
  103.         (Setq e(ssname s1(setq i(1+ i))))
  104.         (vla-getboundingbox (vlax-ename->vla-object e) 'pt1 'pt2)
  105.         (setq
  106.           pt1(vlax-safearray->list pt1)
  107.           pt2 (vlax-safearray->list pt2)
  108.         )
  109.         (setq pt1(list(-(car pt1)0.3)(-(cadr pt1)0.3)))
  110.         (setq pt2(list(+(car pt2)0.3)(+(cadr pt2)0.3)))
  111.         (setq pt3(list(car pt1)(cadr pt2)))
  112.         (setq pt4(list(car pt2)(cadr pt1)))
  113.         (if(< 1(sslength(ssget "_CP" (list pt1 pt3 pt2 pt4))))
  114.           (progn
  115.             (command "_wipeout" "f" "off")
  116.             (command "wipeout" "_non" pt1"_non" pt3 "_non" pt2 "_non" pt4 "c")
  117.             (command "draworder" E "" "f")
  118.           )
  119.         )
  120.       )
  121.     )
  122.   )
  123.   (prin1)
  124. )




评分

参与人数 2明经币 +2 收起 理由
yanshengjiang + 1
bssurvey + 1 赞一个!

查看全部评分

回复

使用道具 举报

panliang9
发表于 2021-12-23 08:57:04 | 显示全部楼层
谢谢楼主分享！！！
回复 支持 反对

使用道具 举报

czb203
发表于 2021-12-28 21:44:21 | 显示全部楼层
谢谢楼主分享！！！
回复 支持 反对

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-11-14 14:27 , Processed in 0.649071 second(s), 30 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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