求一个取得填充中心点的函数?
本帖最后由 尘缘一生 于 2019-12-23 00:01 编辑如题,希望推荐下。。
我写填充面积,总出错,问题在哪?
、
[*];;;批量填充面积----------------(一级)------------------------------
[*](defun btmj (/ ss k ent obj mj pt1)
[*](vl-load-com)
[*](setq ss (ssget (list (cons 0 "HATCH"))))
[*](setq k -1)
[*](if (= nil slsn) (setq slsn 1))
[*](if (/= ss nil)
[*] (progn
[*] (repeat (sslength ss)
[*] (setq ent (ssname ss (setq k (1+ k))))
[*] (setq obj (vlax-ename->vla-object ent))
[*] (setq mj (vla-get-area obj))
[*] (setq pt1 (yy:mid (car (get-box ent)) (cadr (get-box ent))))
[*] ;;;;;;(setq pt1 (cdr (car (reverse (entget ent)))))
[*] (setq mj (* (getvar "dimlfac") (getvar "dimlfac") mj 0.000001))
[*] (entmake (list '(0 . "TEXT") (cons 1 (strcat "S" (itoa slsn) "=" (rtos mj 2 3) "平方米")) (cons 8 "PUB_TEXT")(cons 62 (atoi (slsjqs)))(cons 7 "hz")
[*] (cons 10 pt1)(cons 40 (* slbl 3.5))(cons 50 0.0)(cons 41 0.7))
[*] )
[*] (setq slsn (1+ slsn))
[*]
[*] )
[*] )
[*])
[*])
taoyi0727 发表于 2019-12-23 10:05
我觉得楼有的激情是好的,就是有的时候话不要说的太大
老师傅都是有自己的性格、有自己的脾气。
我总是在思考,向比自己能力强提问,应该虚心,这不丢人。
然后每次看这种帖子,承包看明经论坛的笑点。 slblslsjqs 一些莫名其妙的变量,
程序不全,别人也调试不出来,只有你自己慢慢去试了 每次发帖字体都搞的很大,代码又不按论坛的格式发,莫名其妙的函数名、变量名,还总是牢骚满腹,还总是用点评。 (T-get-object-center-pt (car (entsel)))
(defun T-get-object-center-pt (name)
(setq obj (vlax-ename->vla-object name))
(vla-GetBoundingBox obj 't-min 't-max)
(setq t-min (safearray-value t-min))
(setq t-max (safearray-value t-max))
(polar t-min (angle t-min t-max) (/ (distance t-min t-max) 2))
) 我觉得楼有的激情是好的,就是有的时候话不要说的太大 代码不按论坛格式发,看的好累 zzyong00版主请指教,我不太明白
貌似没有问题
taoyi0727 发表于 2019-12-26 15:39
zzyong00版主请指教,我不太明白
貌似没有问题
你这个只是最小包围框的中点吧?跟填充中心点(质心)不一样。假设从太阳上拉出一根线到地球上,你这样算出的结果就是在那根线上,但填充中心点肯定是在太阳上。
页:
[1]