[讨论]：多义线画中心线,精简!

啵浪鼓 · 发表于 2006-6-17 15:38:33

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

搜罗网络,多是圆,弧,矩形的中心线绘制,却缺少了多义线的中心线程序!

利用eachy大虾下面的程序,可找出圆,弧,矩形,多义线的中心点,后段该怎么写,才能画出中心线,(中心线长超出物体的5mm)

请高手出招!

(defun C:zxc ()
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(setq s (entsel))
(setq obj (vlax-ename->vla-object (car s)))
(vla-getboundingbox obj 'cen_bp 'cen_up)
(setq cen_bp (safearray-value cen_bp))
(setq cen_up (safearray-value cen_up))
(setq mid_pt (polar cen_bp
(angle cen_bp cen_up)
(/ (distance cen_bp cen_up) 2)
)
)
(command "line" mid_pt )
(setvar "osmode" 39)
(prin1)
)

eachy · 发表于 2006-6-17 16:58:30

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

虽然没有Pline绘制中线，但等高线加密也可以用来绘制中线

http://www.xdcad.net/forum/showt ... 2861277#post2861277

啵浪鼓 · 发表于 2006-6-18 21:17:13

链接里的东东不太明白,且没有源程序,想要修改成个性化也无从下手

eachy斑竹能否抽空帮我写一个呀,工作中实在太需要它了,先谢谢了!

xyp1964 · 发表于 2006-6-18 23:24:05

“多义线的中心线”如何定义？

啵浪鼓 · 发表于 2006-6-20 00:22:17

就是以最大长边与最大宽边的中心来画中心线

左边的图为我想要的效果图,右边的图为思路,也就是再怎样怪的多义线,都有一个最大长边与最大宽边,然后长/2,宽/2就得出它们的中心位置了.

xyp1964 · 发表于 2006-6-20 00:56:45

[FONT=courier new](defun c:test ()
(CMDLASC0)
(if (null dist)
(setq dist 100.0)
)
(setq dist (UDIST 7 "" "中心线长<输入或鼠标直接量取>" DIST nil))
(princ "\n选择实体: ")
(setq ss (ssget)
i -1
)
(while (setq s1 (ssname ss (setq i (1+ i))))
(xyp-CrossRed (xyp-get-MinMaxPoint s1 5) (* sc DIST) 1)
)
(CMDLA1)
)[/FONT]

啵浪鼓 · 发表于 2006-6-21 01:00:12

xyp1964斑竹真厉害,就是你这程序才是俺想要滴

程序支持多选,棒极了,运行时速也快,真好的程序!

另,此程序有点不好的就是,如果不知道最大长边与最大宽边的尺寸,有时某些多义线,宽边的中心线多出许多,而长边还没到? 是否只要写出超出最大边界5即可,中心线不一定要等长的,只要超出用户定义的长度即可!

能写出完整代码吗?要改成个性化的东东你的通用涵数让俺无从下手!

eachy · 发表于 2006-6-21 12:36:37

(defun c:tt (/ dis ss ssl i obj bl ur v dx dy pcen p1 p2 p3 p4)
(if (not (setq dis (getdist "\nExtension dist<0.0>: ")))
(setq dis 0.)
)
(if (setq ss (ssget '((0 . "*polyline"))))
(progn
(setq ssl (sslength ss)
i -1
)
(repeat ssl
(setq obj (vlax-ename->vla-object (ssname ss (setq i (1+ i)))))
(vla-getboundingbox obj 'bl 'ur)
(setq bl (trans (safearray-value bl) 0 1)
ur (trans (safearray-value ur) 0 1)
v (mapcar '- ur bl)
dx (/ (car v) 2.)
dy (/ (cadr v) 2.)
pcen (mapcar '(lambda (a b) (/ (+ a b) 2.)) bl ur)
)
(setq p1 (polar pcen pi (+ dx dis))
p2 (polar pcen 0. (+ dx dis))
p3 (polar pcen (* 1.5 pi) (+ dy dis))
p4 (polar pcen (* 0.5 pi) (+ dy dis))
)
(command ".line" "_non" p1 "_non" p2 "")
(command ".line" "_non" p3 "_non" p4 "")
)
)
)
(princ)
)

(defun c:tt (/ dis ss ssl i obj bl ur v dx dy pcen p1 p2 p3 p4) 
  (if (not (setq dis (getdist "\nExtension dist<0.0>: "))) 
    (setq dis 0.) 
  ) 
  (if (setq ss (ssget '((0 . "*polyline")))) 
    (progn 
      (setq ssl        (sslength ss) 
            i        -1 
      ) 
      (repeat ssl 
        (setq obj (vlax-ename->vla-object (ssname ss (setq i (1+ i))))) 
        (vla-getboundingbox obj 'bl 'ur) 
        (setq bl   (trans (safearray-value bl) 0 1) 
              ur   (trans (safearray-value ur) 0 1) 
              v           (mapcar '- ur bl) 
              dx   (/ (car v) 2.) 
              dy   (/ (cadr v) 2.) 
              pcen (mapcar '(lambda (a b) (/ (+ a b) 2.)) bl ur) 
        ) 
        (setq p1 (polar pcen pi (+ dx dis)) 
              p2 (polar pcen 0. (+ dx dis)) 
              p3 (polar pcen (* 1.5 pi) (+ dy dis)) 
              p4 (polar pcen (* 0.5 pi) (+ dy dis)) 
        ) 
        (command ".line" "_non" p1 "_non" p2 "") 
        (command ".line" "_non" p3 "_non" p4 "") 
      ) 
    ) 
  ) 
  (princ) 
)

温柔女神 · 发表于 2006-6-21 13:13:40

最初由 eachy 发布
[B]虽然没有Pline绘制中线，但等高线加密也可以用来绘制中线

http://www.xdcad.net/forum/showt ... 2861277#post2861277 [/B]

下载了总是解压不到，你看看

xyp1964 · 发表于 2006-6-21 13:41:04

[FONT=courier new](defun c:test389 ()
(CMDLASC0)
(if (null dist)
(setq dist 5.0)
)
(if (null ukw)
(setq ukw "1")
)
(setq ukw (UKWORD 1 "1 2" "中心线方式: 1-等长/2-不等长" ukw))
(cond ((= ukw "1")
(setq dist (UDIST 7 "" "中心线定长<输入或鼠标直接量取>" DIST nil))
)
((= ukw "2")
(setq dist (UDIST
7
""
"中心线超出边界长度<输入或鼠标直接量取>"
DIST
nil
)
)
)
)
(princ "\n选择实体: ")
(setq ss (ssget)
i -1
)
(setvar "osmode" 0)
(while (setq s1 (ssname ss (setq i (1+ i))))
(setq pt2 (xyp-get-Pt2XYZ
(xyp-get-MinMaxPoint s1 2)
0
(* dist -1.0)
0
)
pt4 (xyp-get-Pt2XYZ
(xyp-get-MinMaxPoint s1 4)
(* dist -1.0)
0
0
)
pt5 (xyp-get-MinMaxPoint s1 5)
pt6 (xyp-get-Pt2XYZ (xyp-get-MinMaxPoint s1 6) dist 0 0)
pt8 (xyp-get-Pt2XYZ (xyp-get-MinMaxPoint s1 8) 0 dist 0)
)
(cond ((= ukw "1")
(xyp-CrossRed pt5 (* sc DIST) 1)
)
((= ukw "2")
(xyp-mklaco "中心线" 1)
(command "line" pt2 pt8 "")
(command "line" pt4 pt6 "")
)
)
)
(CMDLA1)
)[/FONT]

[FONT=courier new](defun c:test389 () 
  (CMDLASC0) 
  (if (null dist) 
    (setq dist 5.0) 
  ) 
  (if (null ukw) 
    (setq ukw "1") 
  ) 
  (setq ukw (UKWORD 1 "1 2" "中心线方式: 1-等长/2-不等长" ukw)) 
  (cond        ((= ukw "1") 
         (setq dist (UDIST 7 "" "中心线定长<输入或鼠标直接量取>" DIST nil)) 
        ) 
        ((= ukw "2") 
         (setq dist (UDIST 
                      7 
                      "" 
                      "中心线超出边界长度<输入或鼠标直接量取>" 
                      DIST 
                      nil 
                     ) 
         ) 
        ) 
  ) 
  (princ "\n选择实体: ") 
  (setq        ss (ssget) 
        i  -1 
  ) 
  (setvar "osmode" 0) 
  (while (setq s1 (ssname ss (setq i (1+ i)))) 
    (setq pt2 (xyp-get-Pt2XYZ 
                (xyp-get-MinMaxPoint s1 2) 
                0 
                (* dist -1.0) 
                0 
              ) 
          pt4 (xyp-get-Pt2XYZ 
                (xyp-get-MinMaxPoint s1 4) 
                (* dist -1.0) 
                0 
                0 
              ) 
          pt5 (xyp-get-MinMaxPoint s1 5) 
          pt6 (xyp-get-Pt2XYZ (xyp-get-MinMaxPoint s1 6) dist 0 0) 
          pt8 (xyp-get-Pt2XYZ (xyp-get-MinMaxPoint s1 8) 0 dist 0) 
    ) 
    (cond ((= ukw "1") 
           (xyp-CrossRed pt5 (* sc DIST) 1) 
          ) 
          ((= ukw "2") 
           (xyp-mklaco "中心线" 1) 
           (command "line" pt2 pt8 "") 
           (command "line" pt4 pt6 "") 
          ) 
    ) 
  ) 
  (CMDLA1) 
)[/FONT]

dwg001 · 发表于 2006-6-21 14:24:48

中心线以点划线为好。

啵浪鼓 · 发表于 2006-6-21 14:51:18

eachy斑竹的程序测试通过,好用!顶

xyp1964的程序,由于我在公司,没法用你的通用涵数,无法测试,见谅!

aeo · 发表于 2006-6-28 00:32:32

;;;R2006
(defun c:test( / e)
  (setq e(entsel))
  (command "'zoom""o" e "")
  (command "xline""h" (getvar "VIEWCTR") "")
  (command "zoom""P")
)

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

[讨论]：多义线画中心线,精简!

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子