动态绘制闭合多边形---奇怪的现象---增加对象反应器以后，框内图元随多边形同步拉伸

masterlong · 发表于 2021-12-28 19:44:21

本帖最后由 masterlong 于 2022-3-28 23:21 编辑

正在编一个略微有点复杂的程序
远远没有完工
其中某个片段感觉还有点意思
先单独摘出来共享一下
源码放二楼

;=============================
给多边形增加了对象反应器以后
发生奇怪的事情
框内图元随对象拉伸操作同步拉伸
谁能解释下？

------------------------------------------------------------
上面的问题目前无解
怀疑是CAD的BUG
现在只有一个曲线救国的办法
框内目标图元全部复制原件删除

(defun c:tt()
(if (setq ent (car (entsel))
*ent2obj* vlax-Ename->Vla-Object
*obj2ent* vlax-vla-object->ename
*acad* (vlax-get-acad-object)
)
(setq dbpl_obj_Reactor (vlr-object-reactor (list (vlax-Ename->Vla-Object ent)) "" '((:vlr-modified . about_fw_xfs))))
)
)
;;对象反应器
(defun about_fw_xfs( theobj reactor parameter-list )
;;是否已删除
(if (*obj2ent* theobj)
;
;有个奇怪的现象，为啥框内图元会随着多边形的拉伸操作(STRETCH命令拉伸多边形的某一段)，同步执行“拉伸” ？？？？？？？？？
;
(progn
(zoomsave)
(setq theplent (*obj2ent* theobj))
(setq box (entbox theplent))
(zoomptlist box 1.5)
(setq theplptlist (massoc 10 theplent))
(setq ss (ssget "cp" theplptlist '((0 . "CIRCLE") (8 . "0") (62 . 3))))
(if ss
(princ (strcat "\n多边形内找到【 " (itoa (sslength ss)) " 】" ))
(princ "\n多边形内找到【 0 】")
)
(zoomload)
)
)
(princ)
)
;999当前视窗save
(defun zoomsave()
(setq zoom*savelist (list (getvar "ctab") (vlax-3D-Point (trans (getvar "viewctr") 1 0)) (getvar "viewsize")))
)
;999当前视窗load
(defun zoomload()
(if zoom*savelist
(progn
(setvar "ctab" (car zoom*savelist))
(vla-ZoomCenter (vlax-get-acad-object) (trans (cadr zoom*savelist) 0 1) (caddr zoom*savelist))
)
)
)
;;单个物体的最小（正交）包围框---------------------------------这个程序在遇到无法显示的图元时，还是会出错的，比如形。天正图元会不会也不支持，未测试
(defun entbox ( ent / ll ur )
(vla-getboundingbox (*ent2obj* ent) 'll 'ur)
(mapcar 'vlax-safearray->list (list ll ur))
)
;999以指定点表的包围框中心，缩放窗口——————主要用来保证后续可执行 (ssget 'CP/'WP ptlist)
(defun zoomptlist( ptlist sc / box x midpo )
(setq box (npt2box ptlist))
(setq midpo (getmidpo box))
(vla-zoomwindow *acad* (vlax-3d-point (car box)) (vlax-3d-point (cadr box)))
(vla-ZoomScaled *acad* (/ 1.0 sc) 1)
)
;999公共函数
;;求n个点的正交包围框
;;(setq npt (list p1 p2 p3 p4 ... ))
(defun npt2box( npt )
(list
(apply 'mapcar (cons 'min npt))
(apply 'mapcar (cons 'max npt))
)
)
;999公共函数
;;求点对中点
(defun getmidpo( pts / P1 P2 X Y )
(setq p1 (car pts) p2 (cadr pts))
(if (= (length p1) (length p2))
nil
(setq p1 (list (car p1) (cadr p1))
p2 (list (car p2) (cadr p2))
)
)
(mapcar '(lambda (X Y) (/ (+ X Y) 2.0)) P1 P2)
)

(defun c:tt() 
  (if (setq ent (car (entsel)) 
         *ent2obj*  vlax-Ename->Vla-Object 
         *obj2ent*  vlax-vla-object->ename 
         *acad*    (vlax-get-acad-object) 
    ) 
    (setq dbpl_obj_Reactor (vlr-object-reactor (list (vlax-Ename->Vla-Object ent)) "" '((:vlr-modified . about_fw_xfs)))) 
  ) 
) 
;;对象反应器 
(defun about_fw_xfs( theobj reactor parameter-list ) 
  ;;是否已删除 
  (if (*obj2ent* theobj) 
    ; 
    ;有个奇怪的现象，为啥框内图元会随着多边形的拉伸操作(STRETCH命令拉伸多边形的某一段)，同步执行“拉伸”   ？？？？？？？？？ 
    ; 
    (progn 
      (zoomsave) 
      (setq theplent (*obj2ent* theobj)) 
      (setq box (entbox theplent)) 
      (zoomptlist box 1.5) 
      (setq theplptlist (massoc 10 theplent)) 
      (setq ss (ssget "cp" theplptlist '((0 . "CIRCLE") (8 . "0") (62 . 3)))) 
      (if ss 
        (princ (strcat "\n多边形内找到【 " (itoa (sslength ss)) " 】" )) 
        (princ "\n多边形内找到【 0 】") 
      ) 
      (zoomload) 
    ) 
  ) 
(princ) 
) 
;999当前视窗save 
(defun zoomsave() 
  (setq zoom*savelist (list (getvar "ctab") (vlax-3D-Point (trans (getvar "viewctr") 1 0)) (getvar "viewsize"))) 
) 
;999当前视窗load 
(defun zoomload() 
  (if zoom*savelist 
    (progn 
      (setvar "ctab" (car zoom*savelist)) 
      (vla-ZoomCenter (vlax-get-acad-object) (trans (cadr zoom*savelist) 0 1) (caddr zoom*savelist)) 
    ) 
  ) 
) 
;;单个物体的最小（正交）包围框---------------------------------这个程序在遇到无法显示的图元时，还是会出错的，比如形。天正图元会不会也不支持，未测试 
(defun entbox ( ent / ll ur ) 
  (vla-getboundingbox (*ent2obj* ent) 'll 'ur) 
  (mapcar 'vlax-safearray->list (list ll ur)) 
) 
;999以指定点表的包围框中心，缩放窗口——————主要用来保证后续可执行 (ssget 'CP/'WP ptlist) 
(defun zoomptlist( ptlist sc / box x midpo ) 
  (setq box (npt2box ptlist)) 
  (setq midpo (getmidpo box)) 
  (vla-zoomwindow *acad* (vlax-3d-point (car box)) (vlax-3d-point (cadr box))) 
  (vla-ZoomScaled *acad* (/ 1.0 sc) 1) 
) 
;999公共函数 
;;求n个点的正交包围框 
;;(setq npt (list p1 p2 p3 p4 ... )) 
(defun npt2box( npt ) 
  (list 
    (apply 'mapcar (cons 'min npt)) 
    (apply 'mapcar (cons 'max npt)) 
  ) 
) 
;999公共函数 
;;求点对中点 
(defun getmidpo( pts / P1 P2 X Y ) 
  (setq p1 (car pts) p2 (cadr pts)) 
  (if (= (length p1) (length p2)) 
    nil 
    (setq p1 (list (car p1) (cadr p1)) 
        p2 (list (car p2) (cadr p2)) 
    ) 
  ) 
  (mapcar '(lambda (X Y) (/ (+ X Y) 2.0)) P1 P2) 
)

masterlong · 发表于 2021-12-28 19:45:09

本帖最后由 masterlong 于 2021-12-29 18:49 编辑

;;dbx````动态绘制一个闭合的多边形.lsp
(defun c:dbx()
 (princ "dbx````动态绘制一个闭合的多边形，需要至少输入3个点....")
 (setq oldosmode (getvar "osmode"))
 (command "undo" "g")
 (if (and
 (setq p1 (getpoint "\n指定第1点 : "))
 (setvar "orthomode" 0)
 (setq p2 (getpoint p1 "\n指定第2点 : "))
 (setq ptlist (list p2 p1))
 (princ "\n")
 (if dyngrco dyngrco (setq dyngrco 7))
 )
 (progn
 (setq yn_rppt NIL)
 (setvar "osmode" 0)
 (setq loop T)
 (while loop
 (princ "\r指定下一点 : ")
 (setq gr (grread T 15 2))
 (setq grpt (cadr gr)
 mode (car gr)
 )
 ;;pickbox的大小```因为视窗大小在变化，所以dist的具体数值也是变化的
 (setq dist (* (/ (getvar "pickbox") (cadr (getvar "screensize"))) (getvar "viewsize")))

 (cond
 ((= mode 5) (db_dbx_5_grpt)) ;;动态多边形
 ((= mode 3) (db_dbx_3_putapt)) ;;左键定点
 ((or (= mode 11)(= mode 2)) (db_dbx_11_rightclick)) ;;右键结束
 ( T (setq loop NIL) (redraw)) ;;其它中止
 )
 )
 )
 )
(princ)
)

;1`1动态多边形
(defun db_dbx_5_grpt()
 (redraw)
 (setq grptlist (cons grpt ptlist))
 ;;动态多边形时，若鼠标移至ptlist某一点时，自动取代这个点【貌似ok】
 (db_dbx_5_autorppt)
 (grdraw_pline_co ptlist dyngrco)
 (grdraw p1 grpt 6 1)
 (grdraw p2 grpt 6 1)
)
;1`2左键定点
(defun db_dbx_3_putapt()
 (redraw)
 (setq p3 grpt)
 (setq p2 p3)
 (setq ptlist (cons p3 ptlist))
 (grdraw_pline_co ptlist dyngrco)
 (setq yn_rppt NIL) ;;每次定点，重置自动取代
)
;1`3右键结束
(defun db_dbx_11_rightclick()
 (redraw)
 (emkpline ptlist dyngrco)
 (setq loop NIL)
)

;1`1`1动态多边形时，若鼠标移至ptlist某一点时，自动取代这个点
(defun db_dbx_5_autorppt()
 ;;动态坐标超过一定距离以后，自动取代功能生效
 (if (>= 3 (length grptlist))
 (setq yn_rppt NIL)
 (if (< (* 5 dist) (distance grpt p2)) (setq yn_rppt T))
 )
 (if yn_rppt
 (if (setq tmp (vl-some ''((pt) (< (distance grpt pt) (* 0.5 dist))) ptlist))
 (progn
 (setq rept (car (vl-sort ptlist ''((a b) (< (distance grpt a) (distance grpt b))))))
 (setq id (vl-position rept ptlist))
 (setq biao1 (listsub ptlist 0 id)
 biao2 (listsub ptlist (1+ id) (length ptlist))
 )
 (setq ptlist (append biao2 biao1))
 (setq p1 (last ptlist)
 p2 (car ptlist)
 )
 ;;生效一次以后，自动取代功能失效
 (setq yn_rppt NIL)
 )
 )
 )
)

;;按指定颜色生成闭合PL线````70必须在90后面
(defun emkpline( pts co )
(entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 62 co) (cons 90 (length pts)) '(70 . 1))
 (mapcar '(lambda (pt)(cons 10 pt)) pts)
 )
 )
)
;;一个坐标集绘制虚拟闭合线
(defun grdraw_pline_co( pts co / ucspts p1 p2 )
 (setq ucspts pts)
 (mapcar ''((p1 p2) (grdraw p1 p2 co 0)) (cdr ucspts) ucspts)
 (grdraw (car ucspts) (last ucspts) 2 1)
)

;;截取列表的一部分 i=目标子元素的id len=截取的子表个数`````待优化
(defun listsub ( biao i len / a temp one )
(if (and
(= (type i) 'INT)
(>= i 0)
 )
 (progn
(if (or (null len) (< len 0))
(setq len (length biao))
)
(setq a 0)
(setq temp '())
(repeat (length biao)
(setq one (car biao))
(setq biao (cdr biao))
(if (and (>= a i) (< a (+ len i)))
 (setq temp (cons one temp))
)
(setq a (1+ a))
)
(setq biao '())
(repeat (length temp)
(setq one (car temp))
(setq temp (cdr temp))
(setq biao (cons one biao))
)
 )
)
)

masterlong · 发表于 2021-12-29 18:50:23

谢谢
2楼也已更新

;;截取列表的一部分 i=目标子元素的id len=截取的子表个数
(defun listsub ( biao i len / a temp one )
(if (and
(= (type i) 'INT)
(>= i 0)
)
(progn
(if (or (null len) (< len 0))
(setq len (length biao))
)
(setq a 0)
(setq temp '())
(repeat (length biao)
(setq one (car biao))
(setq biao (cdr biao))
(if (and (>= a i) (< a (+ len i)))
(setq temp (cons one temp))
)
(setq a (1+ a))
)
(setq biao '())
(repeat (length temp)
(setq one (car temp))
(setq temp (cdr temp))
(setq biao (cons one biao))
)
)
)
)

masterlong · 发表于 2021-12-28 19:45:49

本帖最后由 masterlong 于 2021-12-28 20:01 编辑

这样做的现实意义么
跟我在编的这个程序功能有关

火灾自动报警平面设计
有一条规范
一个回路不能超过32个点
考虑预留一般限定在25~28之间
这样就经常需要测算实际绘制的点数

我的程序构想是
动态绘制多边形的同时
计算多边形框内消防点数
由于建筑平面的复杂性
多边形的绘制过程中
反复调整多边形界线的概率比较高
动态取代的功能设置
可以大大减少绘制完成后的二次调整

masterlong · 发表于 2021-12-28 19:45:38

本帖最后由 masterlong 于 2021-12-28 19:51 编辑

二楼代码的重点
动态绘制时
若鼠标移动到已有某一点的附近时
会自动取消该点
这样比较方便多边形的即时调整

masterlong · 发表于 2021-12-28 19:46:01

本帖最后由 masterlong 于 2021-12-28 20:06 编辑

整个程序完工以后会共享出来
先把楼占着

动态统计消防点位这个不难
麻烦的是统计数据的实时展示
只靠命令行输出有点难搞
决定上odcl的非模式对话框
同时辅以多边形变色

masterlong · 发表于 2021-12-28 19:46:24

本帖最后由 masterlong 于 2021-12-28 20:12 编辑

绘制的动态多边形
实际上就是取得一个点集
计划在取得点集以后再增密
这样生成的多边形
便于设计过程的后期调整

同时准备再添加反应器
多边形改变顶点位置以后
自动复核框内点数

目前进度可能不到1/20

start4444 · 发表于 2021-12-28 23:53:14

期待大作发布！！！

bssurvey · 发表于 2021-12-29 08:00:39

很棒的一個想法和做法，可以省去很多做圖的時間

Wanda · 发表于 2021-12-29 09:31:06

就很棒

lxl217114 · 发表于 2021-12-29 10:08:43

谢谢分享
先点赞，标记

账号		自动登录	找回密码
密码			注册

[源码] 动态绘制闭合多边形---奇怪的现象---增加对象反应器以后，框内图元随多边形同步拉伸

评分