关于多段线的有趣有挑战性的问题

无痕

如果有弧段还是差一点啊

龙龙仔

alin发表于2004-3-11 6:43:00;<SPAN style=\"FONT-SIZE: 12pt; FONT-FAMILY: 'Times New Roman'; mso-fareast-font-family: 'Times New Roman'; mso-ansi-language: EN-US; mso-fareast-langu...

光直線,程序好像也沒有達到效果
;;對圓弧還是不行!!
;;By 龍龍仔(LUCAS)
;;程序未優化
(defun massoc_t (key alist /)
(apply 'append
(mapcar '(lambda (x)
(if (eq (car x) key)
(list (cdr x))
)
)
alist
)
)
) (defun scanpol (ent / lst pt enti)
(setq lst nil
enti ent
)
(while (/= "SEQEND"
(cdr (assoc 0 (entget (setq enti (entnext enti)))))
)
(setq pt (cdr (assoc 10 (entget enti)))
lst (cons pt lst)
)
)
(reverse lst)
) (defun getboundingbox (ent / ll ur)
(vla-getboundingbox (vlax-ename->vla-object ent) 'll 'ur)
(mapcar 'vlax-safearray->list (list ll ur))
) (defun inter (pl1 pl2 mode / ipts pts)
(setq ipts (vla-intersectwith
(vlax-ename->vla-object pl1)
(vlax-ename->vla-object pl2)
mode
)
ipts (vlax-variant-value ipts)
)
(if (> (vlax-safearray-get-u-bound ipts 1) 0)
(progn (setq ipts
(vlax-safearray->list ipts)
)
(while (> (length ipts) 0)
(setq pts (cons (list (car ipts)
(cadr ipts)
(caddr ipts)
)
pts
)
ipts (cdddr ipts)
)
)
)
)
pts
) (defun tt (ent / etype)
(setq etype (cdr (assoc 0 (entget ent))))
(cond
((= "LWPOLYLINE" etype)
(massoc_t 10 (entget ent))
)
((= "POLYLINE" etype)
(scanpol ent)
)
)
) (defun c:ttt (/ holdosmode dist1 dist dist2 ent box
ent1 lst2 lst n pt pt2 pt1 lst3
p1 p2 l1
)
(command "_.UNDO" "GROUP")
(setq holdosmode (getvar "OSMODE"))
(setvar "OSMODE" 0)
(setq ent (car (entsel)))
(setq box (getboundingbox ent))
;;(vl-cmdf ".RECTANG" (car box) (cadr box))
(setq dist (abs (- (caar box) (caadr box))))
(command "_.COPY" ent "" "0,0" (polar '(0 0) 0.0 dist))
(setq ent1 (entlast))
(command "_.LINE"
(cadr box)
(polar (cadr box) (* 0.5 pi) 10.0)
""
)
(setq l1 (entlast))
(setq lst1 (inter l1 ent acextendthisentity));對圓弧找不到交點???
(setq lst (inter l1 ent1 acextendthisentity);對圓弧找不到交點???
n 0
dist1 1E99
)
(command "_.ERASE" l1 "")
(setq lst (append lst (tt ent1)))
(repeat (length lst)
(setq pt (nth n lst)
dist2 nil
)
(if (= (length pt) 2)
(setq pt (list (car pt) (cadr pt) 0.0))
)
(command "_.LINE"
pt
(polar pt 0 10.0)
""
)
(setq lst2 (inter (entlast) ent acextendthisentity))
(setq pt2 (vl-sort
lst2
'(lambda (p1 p2) (> (car p1) (car p2)))
)
)
(command "_.ERASE" (entlast) "")
(if (not (equal (nth 0 pt2) pt))
(setq dist2 (abs (distance (nth 0 pt2) pt)))
(setq dist2 0)
)
(if (and dist2
(> dist1 dist2)
)
(setq dist1 dist2)
)
(setq n (1+ n))
)
(setq lst1 (append lst1 (tt ent))
n 0
)
(repeat (length lst1)
(setq pt (nth n lst1)
dist2 nil
)
(if (= (length pt) 2)
(setq pt (list (car pt) (cadr pt) 0.0))
)
(command "_.LINE"
pt
(polar pt pi 10.0)
""
)
(setq lst2 (inter (entlast) ent1 acextendthisentity))
(setq pt2 (vl-sort
lst2
'(lambda (p1 p2) (< (car p1) (car p2)))
)
)
(command "_.ERASE" (entlast) "")
(if (not (equal (nth 0 pt2) pt))
(setq dist2 (abs (distance (nth 0 pt2) pt)))
(setq dist2 0)
)
(if (and dist2
(> dist1 dist2)
)
(setq dist1 dist2)
)
(setq n (1+ n))
)
(command "_.MOVE" ent1 "" "0,0" (polar '(0 0) pi dist1))
(command "_.UNDO" "END")
(setvar "OSMODE" holdosmode)
(princ)
)

龙龙仔

match.vlx測試,type match執行

秋枫

我感觉这个要求类似服装CAD系统的计算机自动布料系统所需要的。


各位有没有服装CAD软件推荐？有没有基于AutoCAD的服装CAD软件？

南子

1.重合问题,比如矩形偏移


2.交点问题.我们知道点是没有大小的,但又确实存在.比如两条十字线,您剪掉右边线,那么您就无法剪掉左边线.

BDYCAD

正如14樓秋楓所說. 我想做一個自動排料系統. 以下是我寫的代碼. 希望可以完善.


我需要自動排的效果如下圖所示


       


目前程序完成的效果如下圖所示


       


       


程序代碼如下.


       


測試圖如下


       


       

龙龙仔

自動排是不太可能,半自動一次兩件兩件靠近是可以,類似我提供那種,有需要的話(說一聲)我可以改一下

BDYCAD

其實我以前看了你的程序后我就開始想寫一個這樣的功能哦. 我上午看了很久你上面的程序. 不同點是我處理的全是SPLINE曲線 . 你運用的多是VL我有很多看不懂. 現在還是不明明白如何用你上面的去改進. 還望多多指教呢. 還有希望可以看到你是如何實現半自動的. 好吧就先行謝謝您了. 呵呵 : )

龙龙仔

BDYCAD:

先發個vlx函數給你使用!

;;By 龍龍仔(LUCAS)

;;注意:<指定基準點>靠近移動件,<指定位移方向>指向不動件

;;當兩件沒有接觸點,程序會..........無法停止(按ESC吧!)

;;Usagematch <選取不動件> <選取移動件> <指定基準點> <指定位移方向>)

(defun C:TT (/ ENT ENT1 PT1 PT2)

(while (not (setq ENT (car (entsel "\n選取不動件: ")))))

(while (not (setq ENT1 (car (entsel "\n選取移動件: ")))))

(setq PT1 (getpoint "\n指定基準點: "))

(setq PT2 (getpoint PT1 "\n指定位移方向第二點: "))

(MATCH ENT ENT1 PT1 PT2)

(princ)

)

zoe

14楼所说的正是我现在最需要的，大家可以帮帮忙吗？