- 积分
- 30843
- 明经币
- 个
- 注册时间
- 2013-1-25
- 在线时间
- 小时
- 威望
-
- 金钱
- 个
- 贡献
-
- 激情
-
|

楼主 |
发表于 2019-8-11 21:46:58
|
显示全部楼层
本帖最后由 尘缘一生 于 2019-8-11 22:01 编辑
本来不该问的,就是懒得研究,程序写好了,不知道大家觉得怎么样,有人说你怎么要这个玩艺,对,我确实需要,批量画这些小点,下面程序是不能直接用的,因为有些全局变量没有给数据。
拼凑程序来自本坛,不一一注明。
- ;;-------标准尺寸界线--开始----------------------------
- (defun c:ccjx-h(/ ss n p ang pts spname 1st )
- (setq spname (nth 0 (entsel "\n请选择尺寸线【定角度】:"))) ;;;;;;取得线性实体的实体名
- (setq ang (sl-entang spname))
- (setq ang (* 180.0 (/ ang pi))) ;弧度转角度
- (setq 1st (list spname)) ;;;;;实体名构建表1st
- (setq ss (ssget '((0 . "*LINE,ARC,CIRCLE,ELLIPSE"))))
- (setq p (sslength ss))
- (setq n 0)
- (setq p (- p 1))
- (while (<= n p)
- (setq spname (ssname ss n))
- (setq 1st (cons spname 1st)) ;;;;;创建1st表,并把 spname 放在开头
- (setq n (+ n 1))
- )
- (setq 1st (gps->lst-delsame 1st)) ;;;删除表中重复图元
- (setq pts (sl-ssinters 1st))
- (foreach pt pts
- (command "-insert" "_archtick" pt SLBL SLBL ang)
- )
- )
- ;;;xshrimp的函数(一级函数)
- ;;;删除表中重复图元.不支持表中表的重复图元.
- ;;; (gps->lst-delsame '(1 2 1 2 (1 1) (1 2 1 2 1) 1 2 (1 1) (1 2)))
- ;;; -->(1 2 (1 1) (1 2 1 2 1) (1 2))
- (defun gps->lst-delsame (lst / lstitem lstnew)
- (foreach lstitem lst
- (if (not (member lstitem lstnew))
- (setq lstnew (append lstnew (list lstitem)))
- )
- )
- lstnew
- )
- ;;--取线性实体角度 ang-输出为弧度-(一级函数)---------------------------------------------------
- ;;--spname为线性实体的实体名-----------------------------------------------------
- (defun sl-entang (spname / pt1 pt3 pt4 k1 k2 ang)
- (if (= "LINE" (cdr (assoc 0 (entget spname))))
- (progn
- (setq pt1 (entget spname))
- (setq pt3 (cdr (assoc 10 pt1)))
- (setq pt4 (cdr (assoc 11 pt1)))
- )
- )
- (if (= "LWPOLYLINE" (cdr (assoc 0 (entget spname))))
- (progn
- (setq pt3 (vlax-curve-getstartpoint spname)) ; 对象的起点
- (setq pt4 (vlax-curve-getendpoint spname)) ; 对象的终点
- )
- )
- (setq k1 (nth 0 pt3)) ;;;;;点的X坐标
- (setq k2 (nth 0 pt4)) ;;;;;点的X坐标
- (if (< k1 k2)
- (setq ang (angle pt3 pt4))
- )
- (if (< k2 k1)
- (setq ang (angle pt4 pt3))
- )
- (if (= k2 k1)
- (setq ang (/ pi 2))
- )
- ang ;;;;弧度角度
- )
- ;;;曲线【实体名表】--求交点(一级函数)
- (defun sl-ssinters (spname / pts en1 en2 spname1)
- (while (setq en1 (car spname))
- (setq spname (cdr spname));;;剩下的元素
- (setq spname1 spname)
- (while (setq en2 (car spname1));;;返回表中的第一个元素
- (setq pts (append pts (sl-Curveinters en1 en2)))
- (setq spname1 (cdr spname1));;;剩下的元素
- )
- )
- pts
- )
- ;;;曲线【选择集交点】-求交点(一级函数)(备用)
- (defun ss-ssinters (ss / pts en1 en2)
- (while (> (sslength ss) 1)
- (setq en1 (ssname ss 0))
- (ssdel en1 ss)
- (setq n (sslength ss))
- (repeat n
- (setq en2 (ssname ss (setq n (1- n))))
- (setq pts (append pts (sl-Curveinters en1 en2)))
- )
- )
- pts
- )
- ;;说明:;;;两实体交点,en1 en2 为实体名 (一级函数)
- (defun sl-Curveinters (en1 en2 / pl pts)
- (setq pl (vlax-invoke (vlax-ename->vla-object en2) 'IntersectWith (vlax-ename->vla-object en1) acExtendNone))
- (while pl
- (setq pts (append pts (list (list (car pl) (cadr pl) (caddr pl))))
- pl (cdr (cdr (cdr pl)))
- )
- )
- pts
- )
- ;;说明:;;---------尺寸界线----结束
|
本帖子中包含更多资源
您需要 登录 才可以下载或查看,没有账号?注册
x
|