LISP例程开发square
嘿伙计们，我们目前正在办公室做一些降落伞工作，需要开发一些弯曲/折板工作。我们花费时间最多的项目似乎是方形到圆形的过渡段，其中斜槽壁由一个板制成，折叠成所需的形状。
我相信你们大多数人都熟悉这种类型的工作，但我只是想知道是否有人知道一个好的程序，可以轻松地产生这些过渡段的发达/扁平板。
我们一直在使用这个网站。。。http://www.sheetmetalguy.com/transition.htm...当它工作时，它确实工作得很好（看起来这个网站很旧，有时只会在IE中运行）。
所以我在想，如果有一个例程，要求用户选择一个二维正方形/矩形和一个二维圆形，那就太好了。。。该例程将计算两个形状之间的距离（Z值），然后生成所需形状的二维平坦轮廓。
有人知道这样的例行公事吗？
我确实有一点Lisp程序的经验，但我想像这样的事情可能会涉及我的头。
非常感谢您的帮助。
干杯 试试这个。。。
关于，
M、 R。 代码最终修订-您可以在第#7。。。
当做
M、 R。 哇，太棒了。。。非常感谢Marko。
我不得不删除这行。。。
;; Program Bentangan Ducting Transisi Kotak ke Lingkaran
;; DR2C Beta Version 0.0
;; Program ini hanya bekerja untuk 4 segment
;; Dibuat : Afrizanirman
;; Email : udaaf@yahoo.co.id
;; Tgl Pembuatan : 15/3/2012
;; Tangent-Lee Mac
;; Args: x - real
(defun tan ( x )
(if (not (equal 0.0 (cos x) 1e-10))
(/ (sin x) (cos x))
)
)
;; ArcSine-Lee Mac
;; Args: -1 <= x <= 1
(defun asin ( x )
(cond
( (equal (abs x) 1.0 1e-10)
(* x pi 0.5)
)
( (< -1.0 x 1.0)
(atan x (sqrt (- 1.0 (* x x))))
)
)
)
;; ArcCosine-Lee Mac
;; Args: -1 <= x <= 1
(defun acos ( x )
(cond
( (equal x1.0 1e-10)
0.0
)
( (equal x -1.0 1e-10)
pi
)
( (< -1.0 x 1.0)
(atan (sqrt (- 1.0 (* x x))) x)
)
)
)
;; Hyperbolic Sine-Lee Mac
;; Args: x - real
(defun sinh ( x )
(/ (- (exp x) (exp (- x))) 2.0)
)
;; Hyperbolic Cosine-Lee Mac
;; Args: x - real
(defun cosh ( x )
(/ (+ (exp x) (exp (- x))) 2.0)
)
;; Hyperbolic Tangent-Lee Mac
;; Args: x - real
(defun tanh ( x )
(/ (sinh x) (cosh x))
)
;; Area Hyperbolic Sine-Lee Mac
;; Args: x - real
(defun asinh ( x )
(log (+ x (sqrt (1+ (* x x)))))
)
;; Area Hyperbolic Cosine-Lee Mac
;; Args: 1 <= x
(defun acosh ( x )
(if (<= 1.0 x)
(log (+ x (sqrt (1- (* x x)))))
)
)
;; Area Hyperbolic Tangent-Lee Mac
;; Args: -1 < x < 1
(defun atanh ( x )
(if (< (abs x) 1.0)
(/ (log (/ (1+ x) (- 1.0 x))) 2.0)
)
)
;convert degree to radian
(defun DTR (x)
(* PI (/ x 180.0))
);defun
;Global Variable untuk mengkonversi radian ke dalam degree
(defun RTD (x)
(* x (/ 180.0 PI))
);defun
(defun c:DR2C ()
(setq oldOsmode (getvar "OSMODE"))
;Setting nilai default H1 = 200 mm
(setq oldH1 200)
(if (= (setq H1 (getreal (strcat "Masukan Nilai Awal H1" "<"(rtos oldH1)">"))) nil)
(setq H1 oldH1)
(setq H1 H1)
);end if
;Setting nilai default H2 = 150 mm
(setq oldH2 150)
(if (= (setq H2 (getreal (strcat "Masukan Nilai Awal H2" "<"(rtos oldH2)">"))) nil)
(setq H2 oldH2)
(setq H2 H2)
);end if
;Setting nilai default V1 = 150 mm
(setq oldV1 150)
(if (= (setq V1 (getreal (strcat "Masukan Nilai Awal V1" "<"(rtos oldV1)">"))) nil)
(setq V1 oldV1)
(setq V1 V1)
);end if
;Mencari nilai PQ
(setq PV V1
VQ (/ (- H1 H2) 2)
PQ (sqrt (+(expt PV 2) (expt VQ 2)))
); end setq
;Mencari nilai DQ
(setq PD (/ H1 2)
DQ (sqrt (+(expt PQ 2) (expt PD 2)))
)
;Mencari nilai Db
(setq P0 (/ H1 2)
PD (/ H1 2)
b0 (/ H2 2)
Db (- (sqrt (+ (expt P0 2) (expt PD 2))) b0)
);setq
;Mencari nilai ne
(setq de Db
dn V1
ne (sqrt (+ (expt de 2) (expt dn 2)))
);setq
;Mencari panjang busur bc
(setq C (/ 90.0 4)
r (/ H2 2)
bc (* 2 r (sin (/ (DTR c) 2)))
);setq
;Mencari panjang rusuk Dc dengan mencari panjang ec, eb terlebih dahulu
(setq xc (* r (sin(DTR C)))
bx (sqrt (- (expt bc 2) (expt xc 2)))
Dx (+ Db bx)
Dc (sqrt (+ (expt xc 2) (expt Dx 2)))
);setq
;Mencari nilai nf
(setq df Dc
nf (sqrt (+ (expt df 2) (expt dn 2)))
);setq
;Mencari panjang nilai Betha1
(setq UQ bc
DU nf
CosB (/ (-(+ (expt DU 2) (expt DQ 2)) (expt UQ 2)) (* 2 DU DQ))
Betha1 (acos CosB)
);setq
;Mencari panjang nilai Betha2
(setq WU bc
DW ne
CosB2 (/ (-(+ (expt DW 2) (expt DU 2)) (expt WU 2)) (* 2 DW DU))
Betha2 (acos CosB2)
);setq
;Membuat Point Bentangan
(setq AD H1
PT0 (getpoint "\nTentukan Titik Peletakan:")
PT2 (polar PT0 (DTR 0.0) (/ AD 2))
PT3 (polar PT0 (DTR 90.0) PQ)
PT1 (polar PT0 (DTR 180.0) (/ AD 2))
);setq
(setq alpha (asin (/ PQ DQ)))
(setq PT4 (polar PT1 (+ alpha betha1) DU))
(setq PT5 (polar PT1 (+ alpha betha1 betha2) DW))
(setq PT6 (polar PT1 (+ alpha betha1 betha2 betha2) DU))
(setq PT7 (polar PT1 (+ alpha betha1 betha2 betha2 Betha1) DQ))
;Membuat Object Segitiga dan rusuk
(setvar "OSMODE" 0)
(command "LINE" PT1 PT2 PT3 "C")
(command "LINE" PT1 PT4 "")
(command "LINE" PT1 PT5 "")
(command "LINE" PT1 PT6 "")
(command "LINE" PT1 PT7 "")
(setvar "OSMODE" oldOsmode)
(princ)
);defun
(Princ)
由于我无法运行例程（就像我尝试清空DWG一样），例程仍然认为DWG中存在实体。
DWG必须为空有特殊原因吗？当DWG中没有形状可以拾取点时，我只能手动输入值-我可以尝试写入一两行，这将允许例程在屏幕上作为对象时运行-但在例程进行时将其删除。
再次感谢你的帮助。 我希望DWG为空的原因是例程末尾的这些行。。。
;; 2-Circle Intersection-Lee Mac
;; Returns the point(s) of intersection between two circles
;; with centres c1,c2 and radii r1,r2
(defun LM:Inters2Circle ( c1 r1 c2 r2 / n d1 x z )
(if
(and
(< (setq d1 (distance c1 c2)) (+ r1 r2))
(< (abs (- r1 r2)) d1)
)
(progn
(setq n(mapcar '- c2 c1)
c1 (trans c1 0 n)
z(/ (- (+ (* r1 r1) (* d1 d1)) (* r2 r2)) (+ d1 d1))
)
(if (equal z r1 1e-
(list (trans (list (car c1) (cadr c1) (+ (caddr c1) z)) n 0))
(progn
(setq x (sqrt (- (* r1 r1) (* z z))))
(list
(trans (list (- (car c1) x) (cadr c1) (+ (caddr c1) z)) n 0)
(trans (list (+ (car c1) x) (cadr c1) (+ (caddr c1) z)) n 0)
)
)
)
)
)
)
(defun mid (p1 p2)
(mapcar '(lambda (a b) (/ (+ a b) 2.0)) p1 p2)
)
(defun c:rectround ( / AP ARCENT CMDE D DD DIA ENPAR HIG INCRPAR K LEN OSM P1 P1O P2 P2O P3 PT PTE PTLST PTM PTO PTOO PTTT RAD RECENT REG SEG SOL SS STPAR WID )
(vl-load-com)
(if (not (vl-catch-all-error-p (vl-catch-all-apply 'sslength (list (ssget "_X"))))) (progn (alert "\nWarning DWG contains entities - there must be no entities - exiting") (exit)))
(vl-cmdf "_.ucs" "w")
(vl-cmdf "_.plan" "")
(vl-cmdf "_.zoom" "c" '(0.0 0.0 0.0) 1.0)
(vl-cmdf "_.zoom" "v")
(setq osm (getvar 'osmode))
(setq cmde (getvar 'cmdecho))
(setq ap (getvar 'aperture))
(setvar 'aperture 25)
(setvar 'cmdecho 0)
(setvar 'osmode 0)
(vl-cmdf "osnap" "off")
;(vl-cmdf "_.align")
(arxload "geom3d.arx") ; initialize (align) subfunction
(prompt "\nRECTROUND TRANSITION ROUTINE - ENTER TO CONTINUE")
(vl-cmdf pause)
(setq dia (getdist "\nInput diameter of Round (pick 2 points) : "))
(setq rad (/ dia 2.0))
(setq len (getdist "\nInput length of rectangle (pick 2 points) : "))
(setq wid (getdist "\nInput width of rectangle (pick 2 points) : "))
(setq hig (getdist "\nInput height of transition (pick 2 points) : "))
(initget 6)
(setq seg (getint "\nInput number of segemnts per vertex of rectangle : "))
(vl-cmdf "_.arc" "c" (list 0.0 0.0 hig) (list rad 0.0 hig) (list 0.0 rad hig))
(if (> (getvar 'cmdactive) 0) (vl-cmdf ""))
(setq arcent (entlast))
(setq stpar (vlax-curve-getparamatpoint arcent (list rad 0.0 hig)))
(setq enpar (vlax-curve-getparamatpoint arcent (list 0.0 rad hig)))
(setq incrpar (/ (- enpar stpar) (float seg)))
(setq k -1)
(repeat (+ seg 1)
(setq pt (vlax-curve-getpointatparam arcent (+ stpar (* (float (setq k (1+ k))) incrpar))))
(setq ptlst (cons pt ptlst))
)
(setq ptlst (reverse ptlst))
(cond
((and (equal rad (/ len 2.0) 1e- (equal rad (/ wid 2.0) 1e-)
(vl-cmdf "_.rectangle" '(0.0 0.0 0.0) (list rad rad 0.0))
(if (> (getvar 'cmdactive) 0) (vl-cmdf ""))
)
((or (and (> rad (/ len 2.0)) (> rad (/ wid 2.0))) (and (equal rad (/ len 2.0) 1e- (> rad (/ wid 2.0))) (and (> rad (/ len 2.0)) (equal rad (/ wid 2.0) 1e-))
(vl-cmdf "_.pline" '(0.0 0.0 0.0) (list rad 0.0 0.0) "a" "s" (list (* (sqrt 0.5) rad) (* (sqrt 0.5) rad) 0.0) (list 0.0 rad 0.0) "l" "c")
)
((or (and (< rad (/ len 2.0)) (< rad (/ wid 2.0))) (and (equal rad (/ len 2.0) 1e- (< rad (/ wid 2.0))) (and (< rad (/ len 2.0)) (equal rad (/ wid 2.0) 1e-))
(vl-cmdf "_.rectangle" '(0.0 0.0 0.0) (list (/ len 2.0) (/ wid 2.0) 0.0))
(if (> (getvar 'cmdactive) 0) (vl-cmdf ""))
)
((and (> rad (/ len 2.0)) (< rad (/ wid 2.0)))
(vl-cmdf "_.rectangle" '(0.0 0.0 0.0) (list rad (/ wid 2.0) 0.0))
(if (> (getvar 'cmdactive) 0) (vl-cmdf ""))
)
((and (< rad (/ len 2.0)) (> rad (/ wid 2.0)))
(vl-cmdf "_.rectangle" '(0.0 0.0 0.0) (list (/ len 2.0) rad 0.0))
(if (> (getvar 'cmdactive) 0) (vl-cmdf ""))
)
)
(vl-cmdf "_.extrude" (entlast) "" hig)
(setq sol (entlast))
(vl-cmdf "_.slice" sol "" "3" (list (/ len 2.0) 0.0 0.0) (list (/ len 2.0) (/ wid 2.0) 0.0) (car ptlst) '(0.0 0.0 0.0))
(setq k -1)
(repeat seg
(vl-cmdf "_.slice" sol "" "3" (nth (setq k (1+ k)) ptlst) (nth (+ k 1) ptlst) (list (/ len 2.0) (/ wid 2.0) 0.0) '(0.0 0.0 0.0))
)
(vl-cmdf "_.slice" sol "" "3" (list 0.0 (/ wid 2.0) 0.0) (list (/ len 2.0) (/ wid 2.0) 0.0) (last ptlst) '(0.0 0.0 0.0))
(vl-cmdf "_.mirror" sol "" '(0.0 0.0 0.0) '(0.0 1.0 0.0) "")
(setq ss (ssadd))
(ssadd sol ss)
(ssadd (entlast) ss)
(vl-cmdf "_.union" ss "")
(setq sol (entlast))
(vl-cmdf "_.mirror" sol "" '(1.0 0.0 0.0) '(0.0 0.0 0.0) "")
(setq ss (ssadd))
(ssadd sol ss)
(ssadd (entlast) ss)
(vl-cmdf "_.union" ss "")
(entdel arcent)
(vl-cmdf "_.copybase" '(0.0 0.0 0.0) (entlast) "")
(vl-cmdf "_.slice" (entlast) "" "ZX" '(0.0 0.0 0.0) '(1.0 1.0 0.0))
(vl-cmdf "_.slice" (entlast) "" "YZ" '(0.0 0.0 0.0) '(1.0 1.0 0.0))
(vl-cmdf "_.explode" (entlast) "")
(setq ss (ssget "_C" '(1.0 -1.0 0.0) '(-1.0 1.0 0.0)))
(vl-cmdf "_.erase" ss "")
(vl-cmdf "_.vpoint" "-1.0,-1.0,1.0")
(setq pt (list 0.0 (+ (/ wid 2.0) (distance (list 0.0 (/ wid 2.0) 0.0) (list 0.0 rad hig))) 0.0))
(setq ss (ssget "_C" (list -0.1 (- (/ wid 2.0) 0.1) 0.0) (list 0.1 (+ (/ wid 2.0) 0.1) 0.0)))
(vl-cmdf "_.ucs" "e" (list 0.0 (/ wid 2.0) 0.0))
(vl-cmdf "_.explode" ss "")
(vl-cmdf "_.pedit" "l" "" "j" "p" "" "")
(vl-cmdf "_.ucs" "w")
(setq ss (ssget "_L"))
(align ss (list 0.0 (/ wid 2.0) 0.0) (list 0.0 (/ wid 2.0) 0.0) (list (/ len 2.0) (/ wid 2.0) 0.0) (list (/ len 2.0) (/ wid 2.0) 0.0) (list 0.0 rad hig) pt)
(setq k -1)
(setq ptlst (reverse ptlst))
(setq d (distance (nth 0 ptlst) (nth 1 ptlst)))
(repeat seg
(setq dd (distance (list (/ len 2.0) (/ wid 2.0) 0.0) (nth (+ (setq k (1+ k)) 1) ptlst)))
(setq pto pt)
(setq pt (car (LM:Inters2Circle (list (/ len 2.0) (/ wid 2.0) 0.0) dd pto d)))
(setq pt (list (car pt) (cadr pt) 0.0))
(setq ss (ssget (mid (setq ptoo (osnap (nth k ptlst) "_non")) (setq pttt (osnap (nth (+ k 1) ptlst) "_non")))))
(align ss (list (/ len 2.0) (/ wid 2.0) 0.0) (list (/ len 2.0) (/ wid 2.0) 0.0) ptoo pto pttt pt)
(vl-cmdf "_.ucs" "e" pt)
(vl-cmdf "_.explode" ss "")
(vl-cmdf "_.pedit" "l" "" "j" "p" "" "")
(vl-cmdf "_.ucs" "w")
(setq ss (ssget "_L"))
(align ss (setq p1 (osnap (setq p1o (cdr (assoc 10 (entget (ssname ss 0))))) "_end")) (list (car p1) (cadr p1) 0.0) (setq p2 (osnap (setq p2o (cdr (assoc 10 (cdr (member (list 10 (car p1o) (cadr p1o)) (entget (ssname ss 0))))))) "_end")) (list (car p2) (cadr p2) 0.0) (setq p3 (osnap (cdr (assoc 10 (cdr (member (list 10 (car p2o) (cadr p2o)) (entget (ssname ss 0)))))) "_end")) (list (car p3) (cadr p3) 0.0))
)
(setq ptm (mid (list (/ len 2.0) (/ wid 2.0) 0.0) pt))
(setq pte (cadr (LM:Inters2Circle ptm (distance ptm pt) (list (/ len 2.0) (/ wid 2.0) 0.0) (/ len 2.0))))
(if (eq pte nil) (setq pte (cadr (LM:Inters2Circle pt (distance (list (/ len 2.0) 0.0 0.0) (last ptlst)) (list (/ len 2.0) (/ wid 2.0) 0.0) (/ len 2.0)))))
(setq pte (list (car pte) (cadr pte) 0.0))
(setq ss (ssget "_C" (list (- (/ len 2.0) 0.1) -0.1 0.0) (list (+ (/ len 2.0) 0.1) 0.1 0.0)))
(align ss (list (/ len 2.0) (/ wid 2.0) 0.0) (list (/ len 2.0) (/ wid 2.0) 0.0) (list rad 0.0 hig) pt (list (/ len 2.0) 0.0 0.0) pte)
(vl-cmdf "_.ucs" "e" pte)
(vl-cmdf "_.explode" ss "")
(vl-cmdf "_.pedit" "l" "" "j" "p" "" "")
(vl-cmdf "_.ucs" "w")
(setq ss (ssget "_L"))
(align ss (setq p1 (osnap (setq p1o (cdr (assoc 10 (entget (ssname ss 0))))) "_end")) (list (car p1) (cadr p1) 0.0) (setq p2 (osnap (setq p2o (cdr (assoc 10 (cdr (member (list 10 (car p1o) (cadr p1o)) (entget (ssname ss 0))))))) "_end")) (list (car p2) (cadr p2) 0.0) (setq p3 (osnap (cdr (assoc 10 (cdr (member (list 10 (car p2o) (cadr p2o)) (entget (ssname ss 0)))))) "_end")) (list (car p3) (cadr p3) 0.0))
(if (and (equal p1 pt 1e-6) (equal p2 (list (/ len 2.0) (/ wid 2.0) 0.0) 1e-6)) (setq pte p3))
(if (and (equal p2 pt 1e-6) (equal p1 (list (/ len 2.0) (/ wid 2.0) 0.0) 1e-6)) (setq pte p3))
(if (and (equal p3 pt 1e-6) (equal p1 (list (/ len 2.0) (/ wid 2.0) 0.0) 1e-6)) (setq pte p2))
(if (and (equal p1 pt 1e-6) (equal p3 (list (/ len 2.0) (/ wid 2.0) 0.0) 1e-6)) (setq pte p2))
(if (and (equal p3 pt 1e-6) (equal p2 (list (/ len 2.0) (/ wid 2.0) 0.0) 1e-6)) (setq pte p1))
(if (and (equal p2 pt 1e-6) (equal p3 (list (/ len 2.0) (/ wid 2.0) 0.0) 1e-6)) (setq pte p1))
(vl-cmdf "_.plan" "")
(vl-cmdf "_.regen")
(vl-cmdf "_.zoom" "v")
(setq ss (ssget "_X" '((0 . "LWPOLYLINE"))))
(vl-cmdf "_.region" ss "")
(setq ss (ssget "_X" '((0 . "REGION"))))
(vl-cmdf "_.mirror" ss "" "_non" pte "_non" pt "")
(setq ss (ssget "_X" '((0 . "REGION"))))
(vl-cmdf "_.mirror" ss "" '(0.0 0.0 0.0) '(0.0 1.0 0.0) "")
(vl-cmdf "_.pasteclip" '(0.0 0.0 0.0))
(setvar 'aperture ap)
(setvar 'cmdecho cmde)
(setvar 'osmode osm)
(princ)
)
正如您所看到的，（ssget“_X”）检查所有数据库中的实体，因此，如果您有尚未由例程创建的实体，例程可能也会包括它们，并使用应用于它们的对齐和镜像命令将DWG弄乱。。。
M、 R。 太棒了，非常感谢你的帮助，马尔科。我设法让它工作得很好——大多数时候。虽然我确实得到了一个很好的错误列表，但它确实生成了配置文件。
我发现DWG中可以有不会中断例程的对象，只要它们只是直线。如果我选择为测量拾取点，而不是手动输入值，这将非常方便。
我还发现在模型空间中使用两个视口运行例程很方便。。。主视口是我在其中激活例程的视口（它会自动切换到平面图），第二个视口是我在等轴测视图中留下的。。。这允许我选择形状上的点，然后切换回主视口以输入曲线面/段的数量，并运行其余的例程。
(if (not (vl-catch-all-error-p (vl-catch-all-apply 'sslength (list (ssget "_X"))))) (progn (alert "\nWarning DWG contains entities - there must be no entities - exiting") (exit)))
是我得到的错误，但配置文件仍然生成良好。
再次感谢你的帮助，马尔科。 大家好，
我很抱歉重提过去，但我只是在重温这一惯例——我找不到办法让它发挥作用。
我记得有一些技巧。。。但这次我运气不好。
只是想知道是否有人可以帮我完善这个转换例程（在第7篇文章中）？
再次感谢。 在这里，我在输入值中添加了一些限制（必须合理，否则会失败）；还添加了对align命令的替代-从www.theswamp获取了Highfyingbird的函数。组织。。。如果它现在失败了，我也帮不了你——这是因为电脑（它在我的电脑上工作）。另外请注意，如果您使用的是A2008或更少版本，则需要将所有带有（vl cmdf“0.explode”ss）的行更改为（vl cmdf“0.explode”ss”）——如果您使用的是A2009或更高版本，则不应更改我刚刚发布的代码中的任何内容。。。
(setq ss (ssget "_X" '((0 . "LWPOLYLINE"))))
(setq ss (ssget "_X" '((0 . "REGION"))))
M.R。
我公司的附加条款。即使我在每个顶点上输入20个以上的线段，它也可以工作，但我强烈建议您，如果不需要，请使用尽可能少的线段。。。 你好，Marko，
再次感谢您的回复。
我的电脑一定出了问题，因为我还是不能用。
您最初的post#7例程有效–只有在我键入值（而不是拾取点）时才有效。
我根本无法让你的新习惯发挥作用。
再次感谢您的帮助-希望其他人能够帮助我。
干杯
这个话题开始过时了。。。所以我决定把它再次变成现实。。。我做了我能做的，你有没有找到解决你的任务的办法？依我之见，我认为这个程序绝对是可靠的类型和能力的计算机你们有。。。有时它可以按需要执行任务，但有时它不做应该做的事情-如果输入太高（每个顶点的段数），它就不能很好地执行切片命令，结果很奇怪，顺便说一句，例程没有完成到最后。。。既然没有人再回复了，我想知道你们是否能够使用这个程序。。。也许现在有人可以提供一些帮助。。。
真的，M.R。
页:
[1]
2