在华氏15度时进行转换乐筑天下 - Powered by Discuz! Archiver

chelsea1307 发表于 2022-7-6 14:29:35

在华氏15度时进行转换

我从cadtutor上得到了这个Lisp程序的词，它是阿斯米写的。有没有办法对其进行编辑，使其以15度的角度从一种管道尺寸过渡到另一种管道尺寸？
CREATES DOUBLE LINE DUCT WITH CAPS AND CORNERS, NO TRANSITIONS
(defun c:dpipe(/ actDoc ang1 ang2 ang3 ptLst enDist
   fPt lEnt lObj lPln oldVars oldWd
   plEnd plStart1 plStart2 prDir
   segLst Start stDist stLst tAng
   vlaPln *error*)

(vl-load-com)
(defun GetPlineVer(plObj)
(mapcar 'cdr
(vl-remove-if-not
'(lambda(x)(=(car x)10))
(entget plObj)))
); end of GetPLineVer
(defun asmi-PlineSegmentDataList(plObj / cLst outLst)
(setq cLst
(vl-remove-if-not
'(lambda(x)(member(car x) '(10 40 41 42)))
(entget plObj))
outLst '()
); end setq
(while cLst
(if(assoc 40 cLst)
(progn
   (setq outLst
(append outLst
   (list
(list
(cdr(assoc 10 cLst))
(cdr(assoc 40 cLst))
(cdr(assoc 41 cLst))
(cdr(assoc 42 cLst))
); end list
); end list
); end if
); end setq
   (repeat 4
(setq cLst(cdr cLst))
); end repeat
   ); end progn
(setq outLst
(append outLst
(list
   (list
(cdr(assoc 10 cLst))
); end list
   ); end list
); end append
cLst nil
); end setq
); end if
); end while
outLst
); end of asmi-GetPlineSegmentData

(defun asmi-LayersUnlock(/ restLst)
(setq restLst '())
(vlax-for lay
(vla-get-Layers
         (vla-get-ActiveDocument
         (vlax-get-acad-object)))
(setq restLst
(append restLst
   (list
   (list
      lay
      (vla-get-Lock lay)
(vla-get-Freeze lay)
      ); end list
   ); end list
   ); end append
); end setq
(vla-put-Lock lay :vlax-false)
(if
(vl-catch-all-error-p
(vl-catch-all-apply
'vla-put-Freeze(list lay :vlax-false)))
t)
); end vlax-for
restLst
); end of asmi-LayersUnlock
(defun asmi-LayersStateRestore(StateList)
(foreach lay StateList
(vla-put-Lock(car lay)(cadr lay))
(if
(vl-catch-all-error-p
(vl-catch-all-apply
'vla-put-Freeze(list(car lay)(nth 2 lay))))
t)
); end foreach
(princ)
); end of asmi-LayersStateRestore
(defun PipeMLineStyle(/ dxfLst mlDict)
(setq dxfLst
(list'(0 . "MLINESTYLE")'(102 . "{ACAD_REACTORS")'(102 . "}")
'(100 . "AcDbMlineStyle") '(2 . "DUCT_PIPE")
'(70 . 272)'(3 . "")'(62 . 256)'(51 . 1.5708)'(52 . 1.5708)
'(71 . 2)'(49 . 0.5)'(62 . 256)'(6 . "BYBLOCK")
'(49 . -0.5)'(62 . 256)'(6 . "BYBLOCK"))); end setq
(if
(null
(member
   (assoc 2 dxfLst)
   (dictsearch
(namedobjdict)
"ACAD_MLINESTYLE")))
(progn
(setq mlDict
   (cdr
   (assoc -1
(dictsearch
(namedobjdict)
"ACAD_MLINESTYLE"))))
(dictadd mlDict
   (cdr(assoc 2 dxfLst))(entmakex dxfLst))
); end progn
); end if
); end of PipeMLineStyle
(defun SideCalculate(Rad Ang)
(setq Ang(- pi Ang))
(*
(/
(sqrt(-(* 2(expt Rad 2))(* 2(expt Rad 2)(cos Ang))))
(sin(- pi Ang)))(sin(/(- pi(- pi Ang))2)
)
)
); end of SideCalculate
(defun *error*(msg)
(setvar "CMDECHO" 0)
(if lObj
(command "_.erase"(entnext lObj)"")
(command "_.erase"(entlast)"")
); end if
(if oldVars
(mapcar 'setvar
'("FILLMODE" "PLINEWID" "CMDECHO" "OSMODE")
oldVars); end mapcar
); end if
(if stLst
(asmi-LayersStateRestore stLst)
); end if
(if actDoc
(vla-EndUndoMark actDoc)
); end if
(princ "*Cancel* ")
(princ)
); end of *error*
(PipeMLineStyle)

(if(not dpipepWd)(setq dpipepWd 1.0))
(setq oldWd dpipepWd
   dpipepWd(getdist
         (strcat "\nSpecify first segment width <" (rtos dpipepWd) ">: "))
oldVars(mapcar 'getvar '("FILLMODE" "PLINEWID" "CMDECHO" "OSMODE"))
   ); end setq
(if(null dpipepWd)(setq dpipepWd oldWd))
(mapcar 'setvar
'("FILLMODE" "PLINEWID" "CMDECHO")
(list 0 dpipepWd 1)); end mapcar
(if(entlast)(setq lObj(entlast)))
(vla-StartUndoMark
(setq actDoc
(vla-get-ActiveDocument
(vlax-get-acad-object))))
(setq fPt
(getpoint "\nSpecify start point: ")
); end setq
(command "_.pline" fPt)
(while(= 1(getvar "CMDACTIVE"))
(command pause)
); end while
(if
(not
(equal lObj(entlast)))
(progn
(setq lEnt(entlast)
   stLst(asmi-LayersUnlock)
segLst(asmi-PlineSegmentDataList lEnt)
vlaPln(vlax-ename->vla-object lEnt)
); end setq
(setvar "OSMODE" 0)
(setvar "CMDECHO" 0)
(while (/= 1(length segLst))
   (setq stDist
   (vlax-curve-getDistAtPoint vlaPln
(caar segLst))
enDist
   (vlax-curve-getDistAtPoint vlaPln
(caadr segLst))
); end setq
(if(< 2(length segLst))
(progn
   (setq ang1
   (+(/ pi 2)(angle(caar segLst)(caadr segLst)))
ang2
   (+(/ pi 2)(angle(caadr segLst)(car(nth 2 segLst))))
); end setq
   ); end progn
); end if
(if
(or
(not Start)
prDir
);end or
   (setq plStart1
   (vlax-curve-getPointAtDist vlaPln
stDist)
Start T); end setq
   (setq plStart1
   (vlax-curve-getPointAtDist vlaPln
(+ stDist(SideCalculate(cadar segLst)ang3)))); end setq
); end if
(if(and ang1 ang2)
(progn
(if(> ang1 ang2)
(setq ang3(- ang1 ang2))
(setq ang3(- ang2 ang1))
); end if
   (setq ang3(- pi ang3)
tAng ang3)
   (if(minusp ang3)(setq ang3(- ang3)))
   ); end progn
); end if
(if
(or
   (equal ang1 ang2 0.000001)
(= 2(length segLst))
   ); end or
   (setq plEnd
      (vlax-curve-getPointAtDist vlaPln
enDist)
prDir T); end setq
      (setq plEnd
      (vlax-curve-getPointAtDist vlaPln
(- enDist(SideCalculate(cadar segLst)ang3)))
prDir nil); end setq
); end if
(if
(< 2(length segLst))
   (setq plStart2
   (vlax-curve-getPointAtDist vlaPln
(+ enDist(SideCalculate(cadar segLst)ang3)))); end setq
); end if
   (if(< 2(length segLst))
   (if
(=(cadar segLst)(nth 2(car segLst)))
(setq ptLst
               (mapcar
   '(lambda(x)(trans x 0 1)); end lambda
            (list(polar plEnd ang1 (/(cadar segLst)2))
   (polar plEnd (+ pi ang1)(/(cadar segLst)2))
   (polar plStart2 (+ pi ang2)(/(cadar segLst)2))
   (polar plStart2 ang2 (/(cadar segLst)2))
   ); end list
      ); end mapcar
); end setq
(setq ptLst
(mapcar
'(lambda(x)(trans x 0 1)); end lambda
   (list (polar plStart1 ang1 (/(cadar segLst)2))
   (polar plStart1 (+ pi ang1)(/(cadar segLst)2))
   (polar(caadr segLst)(+ pi ang2)(/(nth 2(car segLst))2))
   (polar(caadr segLst)ang2(/(nth 2(car segLst))2))
   ); end list
      ); end mapcar
); end setq
   ); end if
); end if
(setq plStart1(trans plStart1 0 1)
   plEnd(trans plEnd 0 1)
); end setq
(if plStart2
   (setq plStart2(trans plStart1 0 1))
   ); end if
   (if
(and
(< 2(length segLst))
(or
   (not(equal ang1 ang2 0.000001))
   (/=(cadar segLst)(nth 2(car segLst)))
); end or
); end and
   (progn
   (setvar "PLINEWID" 0.0)
   (command "_.pline")
(mapcar 'command ptLst)(command "_c")
   (setvar "PLINEWID" dpipepWd)
); end progn
); end if
(if
(and
   (not(equal ang1 ang2 0.000001))
   (< 2(length segLst))
); end and
(progn
   (setq lPln
   (vlax-ename->vla-object(entlast))
   tAng(- ang2 ang1)
); end setq
   (if(minusp tAng)(setq tAng(- tAng)))
   (if
(and
(< 0 tAng)
(>= pi tAng)
); end and
(progn
      (vla-SetBulge lPln 1 (/(- ang2 ang1)4))
      (vla-SetBulge lPln 3 (/(- ang1 ang2)4))
      ); end progn
(progn
(if(< ang1 ang2)
   (setq ang1(+ ang1 pi)
ang2(- ang2 pi)); end setq
   (setq ang1(- ang1 pi)
ang2(+ ang2 pi)); end setq
   ); end if
(vla-SetBulge lPln 1 (/(- ang2 ang1)4))
      (vla-SetBulge lPln 3 (/(- ang1 ang2)4))
); end progn
); end if
   ); end progn
); end if
(if
(=(cadar segLst)(nth 2(car segLst)))
(command "_.mline" "_st" "DUCT_PIPE"
"_S" (cadar segLst) "_J" "_Z"
plStart1 plEnd "")
); end if

(setq segLst(cdr segLst)); end setq
); end while
(command "_.erase" lEnt "")
(asmi-LayersStateRestore stLst)
); end progn
); end if
(vla-EndUndoMark actDoc)
(mapcar 'setvar
'("FILLMODE" "PLINEWID" "CMDECHO" "OSMODE")
oldVars); end apply
(princ)
); end of c:dpipeAttached Images

--------------------------------------------------------------------------------
Last edited by ASMI : 24th Feb 2007 at 07:29 am. Reason: Fixed small bug

MarcoW 发表于 2022-7-6 14:54:25

嗨，Chelsea1307，

你所说的15度的过渡是什么意思？
你可能想在这个论坛上搜索wpipe。lsp例程。
这个论坛上有一些版本。

其中一些对我来说很好。试试看我会说。。。

mdbdesign 发表于 2022-7-6 15:15:05

尝试读取命令行：

D管道
指定第一段宽度：

指定起点：_。普林线
指定起点：
当前线宽为2.0000
指定下一点或[弧/半宽/长度/撤消/宽度]：
指定下一点或[弧（A）/闭合（C）/半宽（H）/长度（L）/撤消（U）/宽度（w）]：w

指定起始宽度：

指定结束宽度：1.5

计算你需要得到的度数和长度。

chelsea1307 发表于 2022-7-6 15:45:34

我希望从一个到另一个的变化始终处于相同的程度，无论它发生在3英寸还是3英尺都无关紧要，只要它以15度的速度发展，我附上了一张图片来展示我在说什么。除此之外，lisp非常适合绘制双线风管，我查看了本网站上发布的其他图片，除此之外，这张图片最适合我。

页: [1]

乐筑天下's Archiver

在华氏15度时进行转换