动态块定向拾取修改参数插件，请各位大神看看【已解决】

a117034423

1. (defun c:dss ()
   
2.   (setvar "cmdecho" 0)
   
3.       (setq osm (getvar "osmode"))
   
4.       (setvar "osmode" 0)
   
5.   ;拾取函数，拾取板尺寸
   
6.   (setq mod1 (vl-remove nil (mapcar  '(lambda (x) (if (= (car x) 10) (cdr x))) (entget (car (entsel "<选择要拾取参数的板：>"))))))
   
7.   (setq ptmin (apply 'mapcar (cons 'min mod1))) ;拾取点表最小坐标值
   
8.   (setq ptmax (apply 'mapcar (cons 'max mod1))) ;拾取点表最大坐标值
   
9.   (setq dxy (mapcar '- ptmax ptmin))
   
10.   (setq dx (atof (rtos (car  dxy) 2 0))) ;矩形X向长度
    
11.   (setq dy (atof (rtos (cadr dxy) 2 0))) ;矩形Y向长度
    
12.   (setq str1 (strcat"板X向长度为：" "<" (rtos dx) ">"))
    
13.   (setq str2 (strcat"板Y向长度为：" "<" (rtos dy) ">"))
    
14.   (print str1)
    
15.   (print str2)
    
16.   ;修改函数，修改动态块
    
17.   (initget "H h V v")
    
18.   (setq  typ1 (getkword "\n<选择板类型:<H:横向板>/<V:竖向板>"))
    
19.   (if (or (= typ1 nil) (=  typ1 "H"))
    
20.   (setq lbc1 dx lbk1 dy)
    
21.   (setq lbc1 dy lbk1 dx)
    
22.   )
    
23.   (setq ts1 (strcat "\n当前板类型为:" (if (or (= typ1 nil) (=  typ1 "H"))
    
24.                                         "<H:横向板>"
    
25.                                         "<V:竖向板>")))
    
26.   (princ ts1)
    
27.   ;拾取修改的动态块
    
28.   (setq dtk1 (car (entsel "\n拾取动态块<退出>:")))
    
29.   (setq dtk2 (vlax-ename->vla-object dtk1))
    
30.   ;计算桁架长度
    
31.   (if (> (- lbc1 (* (fix (/ lbc1 100)) 100)) 50)
    
32.       (setq hjc1 (* (fix (/ lbc1 100)) 100))
    
33.       (setq hjc1 (- (* (fix (/ lbc1 100)) 100) 100))
    
34.                 )
    
35.   ;计算桁架退尺
    
36.   (setq hc1 (- lbc1 hjc1))
    
37.   (setq hc2 (/ hc1 2))
    
38.   (if (= hc2 (fix hc2))
    
39.     (setq hjtc hc2)
    
40.     (setq hjtc (* (atof (rtos (/ hc2 10) 2 0)) 10))
    
41.     )
    
42.   ;拾取钢筋布置间距
    
43.   (setq gjd1 (xdrx_dynblock_GetValue dtk1 "1号筋间距"))
    
44.   (setq gjd2 (xdrx_dynblock_GetValue dtk1 "2号筋间距"))
    
45.   ;计算1号筋标准布置长度
    
46.   (setq bc0 (- lbk1 50))
    
47.   (setq gbc1 (* (fix (/ bc0 gjd1)) gjd1))
    
48.   (if (< (/ (- bc0 gbc1) 2) gjd1)
    
49.       (progn
    
50.         (setq gbc1 (- gbc1 gjd1))
    
51.         (setq qb1 (/ (* (fix (/ (- bc0 gbc1) 10)) 10) 2)) ;起步筋间距
    
52.         ))
    
53.   (if (> qb1 gjd1)
    
54.     (progn
    
55.       (setq gbc1 (+ gbc1 gjd1))
    
56.       (setq qb1 (/ (* (fix (/ (- bc0 gbc1) 10)) 10) 2))
    
57.       ))
    
58.   (setq qb2 (- bc0 gbc1 qb1));末端间距
    
59.   ;动态块修改
    
60.       (xd::block:setdynpropvalue dtk2 "楼板长度" lbc1)
    
61.       (xd::block:setdynpropvalue dtk2 "楼板宽度" lbk1)
    
62.       (xd::block:setdynpropvalue dtk2 "桁架退尺" hjtc)
    
63.       (xd::block:setdynpropvalue dtk2 "桁架长度" hjc1)
    
64. (if (= typ1 "V")
    
65.     (and
    
66.       (xd::block:setdynpropvalue dtk2 "左起步筋间距" qb1)
    
67.       (xd::block:setdynpropvalue dtk2 "右起步筋间距" qb2)
    
68.       )
    
69.     (and
    
70.       (xd::block:setdynpropvalue dtk2 "上起步筋间距" qb1)
    
71.       (xd::block:setdynpropvalue dtk2 "下起步筋间距" qb2)
    
72.       ))
    
73.       (xd::block:setdynpropvalue dtk2 "1号钢筋标准布置长度" gbc1)
    
74. 
    
75.    (setvar "osmode" osm)
    
76.   (princ)
    
77.     )

(defun c:dss ()<br />   (setvar "cmdecho" 0)<br />       (setq osm (getvar "osmode"))<br />       (setvar "osmode" 0)<br />   ;拾取函数，拾取板尺寸<br />   (setq mod1 (vl-remove nil (mapcar  '(lambda (x) (if (= (car x) 10) (cdr x))) (entget (car (entsel "<选择要拾取参数的板：>"))))))<br />   (setq ptmin (apply 'mapcar (cons 'min mod1))) ;拾取点表最小坐标值<br />   (setq ptmax (apply 'mapcar (cons 'max mod1))) ;拾取点表最大坐标值<br />   (setq dxy (mapcar '- ptmax ptmin))<br />   (setq dx (atof (rtos (car  dxy) 2 0))) ;矩形X向长度<br />   (setq dy (atof (rtos (cadr dxy) 2 0))) ;矩形Y向长度<br />   (setq str1 (strcat"板X向长度为：" "<" (rtos dx) ">"))<br />   (setq str2 (strcat"板Y向长度为：" "<" (rtos dy) ">"))<br />   (print str1)<br />   (print str2)<br />   ;修改函数，修改动态块<br />   (initget "H h V v")<br />   (setq  typ1 (getkword "\n<选择板类型:<H:横向板>/<V:竖向板>"))<br />   (if (or (= typ1 nil) (=  typ1 "H"))<br />   (setq lbc1 dx lbk1 dy)<br />   (setq lbc1 dy lbk1 dx)<br />   )<br />   (setq ts1 (strcat "\n当前板类型为:" (if (or (= typ1 nil) (=  typ1 "H"))<br />                                         "<H:横向板>"<br />                                         "<V:竖向板>")))<br />   (princ ts1)<br />   ;拾取修改的动态块<br />   (setq dtk1 (car (entsel "\n拾取动态块<退出>:")))<br />   (setq dtk2 (vlax-ename->vla-object dtk1))<br />   ;计算桁架长度<br />   (if (> (- lbc1 (* (fix (/ lbc1 100)) 100)) 50)<br />       (setq hjc1 (* (fix (/ lbc1 100)) 100))<br />       (setq hjc1 (- (* (fix (/ lbc1 100)) 100) 100))<br />                 )<br />   ;计算桁架退尺<br />   (setq hc1 (- lbc1 hjc1))<br />   (setq hc2 (/ hc1 2))<br />   (if (= hc2 (fix hc2))<br />     (setq hjtc hc2)<br />     (setq hjtc (* (atof (rtos (/ hc2 10) 2 0)) 10))<br />     )<br />   ;拾取钢筋布置间距<br />   (setq gjd1 (xdrx_dynblock_GetValue dtk1 "1号筋间距"))<br />   (setq gjd2 (xdrx_dynblock_GetValue dtk1 "2号筋间距"))<br />   ;计算1号筋标准布置长度<br />   (setq bc0 (- lbk1 50))<br />   (setq gbc1 (* (fix (/ bc0 gjd1)) gjd1))<br />   (if (< (/ (- bc0 gbc1) 2) gjd1)<br />       (progn<br />         (setq gbc1 (- gbc1 gjd1))<br />         (setq qb1 (/ (* (fix (/ (- bc0 gbc1) 10)) 10) 2)) ;起步筋间距<br />         ))<br />   (if (> qb1 gjd1)<br />     (progn<br />       (setq gbc1 (+ gbc1 gjd1))<br />       (setq qb1 (/ (* (fix (/ (- bc0 gbc1) 10)) 10) 2))<br />       ))<br />   (setq qb2 (- bc0 gbc1 qb1));末端间距<br />   ;动态块修改<br />       (xd::block:setdynpropvalue dtk2 "楼板长度" lbc1)<br />       (xd::block:setdynpropvalue dtk2 "楼板宽度" lbk1)<br />       (xd::block:setdynpropvalue dtk2 "桁架退尺" hjtc)<br />       (xd::block:setdynpropvalue dtk2 "桁架长度" hjc1)<br /> (if (= typ1 "V")<br />     (and<br />       (xd::block:setdynpropvalue dtk2 "左起步筋间距" qb1)<br />       (xd::block:setdynpropvalue dtk2 "右起步筋间距" qb2)<br />       )<br />     (and<br />       (xd::block:setdynpropvalue dtk2 "上起步筋间距" qb1)<br />       (xd::block:setdynpropvalue dtk2 "下起步筋间距" qb2)<br />       ))<br />       (xd::block:setdynpropvalue dtk2 "1号钢筋标准布置长度" gbc1)<br /> <br />    (setvar "osmode" osm)<br />   (princ)<br />     )

最近几天基本上是每日一问了，各位审核管理的大大辛苦了
耗时五天 从0基础到写出这一堆代码，请论坛大神看看有没有优化空间
另外想找个师傅给我做些科普与指导，交个朋友定有酬谢，我还想继续往下做功能，想请教一些函数内容如下
1.我想做拾取特定图层批量生成外围圈，论坛内有相似插件可否请大神给我指导注解下
http://bbs.xdcad.net/thread-668171-1-1.html
2.我现在做的是只拾取矩形参数，如果矩形缺掉一个角，如何用liap判定执行另一个命令，且判定缺角的位置用于执行下一个程序3.还有一个多段线避让程序，让PL线避让选定图元


这个命令在执行时，PL线都需要执行哪些动作和运算
4.用lisp在CAD内生成统计表的代码，如果有麻烦也给我参考一下吧，论坛里找了好久了
为了不占用大神时间，大神给个方向就行，让我有目的性去做就可以

xk15c

学习了，还要多学习

newer

0基础，5天能这样了，很厉害了
当然有优化空间
代码不要都顺序结构，要多加入选择分支结构，加强代码的茁壮行，满足某个条件执行哪个分支

比如


(setq mod1 (vl-remove nil (mapcar  '(lambda (x) (if (= (car x) 10) (cdr x))) (entget (car (entsel "<选择要拾取参数的板：>"))))))

要写成这样，

1. (if (and
   
2.       (progn
   
3.         (princ "\n选择要拾取参数的板<退出>:")
   
4.         t
   
5.       )
   
6.       (setq e (car (entsel)))
   
7.       (setq ed (entget e))
   
8.       (wcmatch (cdr (assoc 0 ed)) "*POLYLINE")
   
9.     )
   
10.   (progn
    
11.     (setq mod1 (vl-remove
    
12.                  nil
    
13.                  (mapcar '(lambda (x)
    
14.                             (if        (= (car x) 10)
    
15.                               (cdr x)
    
16.                             )
    
17.                           )
    
18.                          ed
    
19.                  )
    
20.                )
    
21.     )
    
22.   )
    
23.   (progn
    
24.     (princ "\n没有选择到板.")
    
25.   )
    
26. )
    

(if (and<br />       (progn<br />         (princ "\n选择要拾取参数的板<退出>:")<br />         t<br />       )<br />       (setq e (car (entsel)))<br />       (setq ed (entget e))<br />       (wcmatch (cdr (assoc 0 ed)) "*POLYLINE")<br />     )<br />   (progn<br />     (setq mod1 (vl-remove<br />                  nil<br />                  (mapcar '(lambda (x)<br />                             (if        (= (car x) 10)<br />                               (cdr x)<br />                             )<br />                           )<br />                          ed<br />                  )<br />                )<br />     )<br />   )<br />   (progn<br />     (princ "\n没有选择到板.")<br />   )<br /> )<br />

如果你要学XDRX API函数，10天你就能写很复杂的程序了

用XDRX API写上面的

1. (if (setq e (car (xdrx-entsel
   
2.                    "\n选择要拾取参数的板<退出>:"
   
3.                    '((0 . "*polyline"))
   
4.                  )
   
5.             )
   
6.     )
   
7.   (setq mod1 (xdrx-getpropertyvalue e "vertices"))
   
8.   (xdrx-prompt "\n没有选择到板.")
   
9. )
   

(if (setq e (car (xdrx-entsel<br />                    "\n选择要拾取参数的板<退出>:"<br />                    '((0 . "*polyline"))<br />                  )<br />             )<br />     )<br />   (setq mod1 (xdrx-getpropertyvalue e "vertices"))<br />   (xdrx-prompt "\n没有选择到板.")<br /> )<br />

a117034423

newer 发表于 2020-11-29 00:23
0基础，5天能这样了，很厉害了
当然有优化空间
代码不要都顺序结构，要多加入选择分支结构，加强代码的茁 ...

api 的函数我也在参考，但是我现在可以参考的xdrx-api没那么多资料啊

a117034423

newer 发表于 2020-11-29 00:23
0基础，5天能这样了，很厉害了
当然有优化空间
代码不要都顺序结构，要多加入选择分支结构，加强代码的茁 ...

在哪里可以参考更多的Xdrx api呀

XDSoft

a117034423 发表于 2020-11-29 15:52
在哪里可以参考更多的Xdrx api呀

安装目录根下有 API 用户手册

另外 开源函数库论坛和每日插件论坛和API应用论坛，有上千的函数和插件的源代码
读对象属性用 xdrx-getpropertyvalue
写对象属性用 xdrx-setpropertyvalue

这两个函数能解决你80%以上的需要。

他们支持的参数，用只带实体名的参数，可以看到
(xdrx-getpropertyvalue (car (entsel)))
(xdrx-setpropertyvalue (car (entsel)))

a117034423

XDSoft 发表于 2020-11-29 18:06
安装目录根下有 API 用户手册

另外 开源函数库论坛和每日插件论坛和API应用论坛，有上千的函数和插件 ...

谢谢老大提供的函数,我是沈阳的离您很近，所有机会，我希望可以拜访求教

a117034423

XDSoft 发表于 2020-11-29 18:06
安装目录根下有 API 用户手册

另外 开源函数库论坛和每日插件论坛和API应用论坛，有上千的函数和插件 ...

(xdrx-getpropertyvalue (car (entsel)))
对象属性的用法 我在哪里可以学习到 这方面我还没有掌握

smile365408137

其实让构件厂自己避让就好，没必要在钢筋图上画出来。话说大佬有想过自动统计钢筋长度吗