[求助]：如何用lisp让直线和圆相关联

yanxinbo67

有一条line直线和一个圆，直线一端在圆外，一端在圆上，但直线延伸后会通过圆心。现在用stretch命令选择圆和一端直线，后变动圆的位置，结果直线在圆上的端点跟随圆一起移动，直线另一端不动，此时直线延伸后不再经过圆心。如何让直线总是通过圆心呢？

das

先把直线延伸到圆心然后在拉伸不就行了

wkai

楼主具体说说看，在什么情况下使用这样的功能，频率高么？
如果只是十分偶尔的用用的话，没有必要编写程序的。

LUCAS

供參考
http://www.xdcad.net/forum/showt ... d=806456#post806456

yanxinbo67

应该说应用频率还是比较高的。大家都知道有很多组装图纸中需要拉件号，而且有一种件号形式就是直线一端是箭头，另一端是圆，圆中是件号数字。因为我们拉件号时，放圆的位置时不一定合适，我们经常遇到修改件号圆的位置，以便布置的更合理更好看一些，所以用stretch 来改变件号圆的位置，还有存在箭头的方向也偏移了直线方向，每变换一次件号圆的位置，都要调整箭头和圆对直线的相对位置，比较麻烦的，所以想开发一下，箭头和直线和圆相关联。另外可以发现，cad中引线命令qleader可以让直线和箭头相关联，当用stretch对直线一端操作时，另一端箭头会跟着方向的变化，不知是怎样办到的

lijiao

这个不用编了，有现成的，你用AutoCAD Mechanical，里面什么都有，功能强大着呢。

lsjjm

最初由 yanxinbo67 发布
[B]有一条line直线和一个圆，直线一端在圆外，一端在圆上，但直线延伸后会通过圆心。现在用stretch命令选择圆和一端直线，后变动圆的位置，结果直线在圆上的端点跟随圆一起移动，直线另一端不动，此时直线延伸后不再经?.. [/B]

REFER TO :
鼠标拖动序号球
http://p4.xdcad.net/forum/showthread.php?s=&threadid=209190

yanxinbo67

鼠标拖动序号球是不错的，可是另一端的箭头方向怎么办。如果将这条直线换成QLEADER的带箭头的线就好了

LUCAS

2. 
   
3. ;;序號球加反應器早已放出(在”某”個網站---不在明經&也不在曉東)
   
4. ;;有一條line直線和一個圓，直線一端在圓外，一端在圓上，但直線延伸後會通過圓心。
   
5. ;;現在用stretch命令選擇圓和一端直線，後變動圓的位置，結果直線在圓上的端點跟隨
   
6. ;;圓一起移動，直線另一端不動，此時直線延伸後不再經過圓心。如何讓直線總是通過圓心？
   
7. 
   
8. ;;試試以下的程序,使用永久反應裝置
   
9. ;;進行"undo"操作，也不會有錯誤
   
10. ;;By 龍龍仔(LUCAS)
    
11. 
    
12. (defun C:LINE_REACTOR (/ HOLDECHO L1 C1)
    
13.   (vl-load-com)
    
14.   (setq HOLDECHO (getvar "CMDECHO"))
    
15.   (setvar "CMDECHO" 1)
    
16.   (command "_.LINE" PAUSE PAUSE "")
    
17.   (setq L1 (entlast))
    
18.   (command "_.CIRCLE" (getvar "LASTPOINT") PAUSE)
    
19.   (setq C1 (vlax-ename->vla-object (entlast)))
    
20.   (setvar "CMDECHO" 0)
    
21.   (command "_.TRIM"
    
22.            (entlast)
    
23.            ""
    
24.            (list L1 (getvar "LASTPOINT"))
    
25.            ""
    
26.   )
    
27.   (setq L1 (cdr (assoc 5 (entget L1))))
    
28.   (vlr-pers
    
29.     (vlr-object-reactor
    
30.       (list C1)
    
31.       L1
    
32.       '((:vlr-modified . LI))
    
33.     )
    
34.   )
    
35.   (setvar "CMDECHO" HOLDECHO)
    
36.   (princ)
    
37. )
    
38. (prompt "\nType LINE_REACTOR")
    
39. 
    
40. (defun LI (NOTIFIER-OBJECT             REACTOR-OBJECT
    
41.            PARAMETER-LIST             /                  PTC
    
42.            PTR                L1             SPT          ANG
    
43.            DIST
    
44.           )
    
45.   (vl-load-com)
    
46.   (if (not (vlax-erased-p NOTIFIER-OBJECT))
    
47.     (progn
    
48.       (setq
    
49.         PTC (vlax-safearray->list
    
50.               (vlax-variant-value (vla-get-center NOTIFIER-OBJECT))
    
51.             )
    
52.       )
    
53.       (setq PTR (vla-get-radius NOTIFIER-OBJECT))
    
54.       (if (entget (setq L1 (handent (vlr-data REACTOR-OBJECT))))
    
55.         (progn
    
56.           (setq L1 (vlax-ename->vla-object L1))
    
57.           (setq
    
58.             DIST (- (distance (setq SPT        (vlax-safearray->list
    
59.                                           (vlax-variant-value
    
60.                                             (vla-get-startpoint L1)
    
61.                                           )
    
62.                                         )
    
63.                               )
    
64.                               PTC
    
65.                     )
    
66.                     PTR
    
67.                  )
    
68.           )
    
69.           (setq ANG (angle SPT PTC))
    
70.           (vla-put-endpoint L1 (vlax-3d-point (polar SPT ANG DIST)))
    
71.         )
    
72.       )
    
73.     )
    
74.   )
    
75.   (princ)
    
76. )
    

<br /> ;;序號球加反應器早已放出(在”某”個網站---不在明經&也不在曉東)<br /> ;;有一條line直線和一個圓，直線一端在圓外，一端在圓上，但直線延伸後會通過圓心。<br /> ;;現在用stretch命令選擇圓和一端直線，後變動圓的位置，結果直線在圓上的端點跟隨<br /> ;;圓一起移動，直線另一端不動，此時直線延伸後不再經過圓心。如何讓直線總是通過圓心？ <br /> <br /> ;;試試以下的程序,使用永久反應裝置<br /> ;;進行"undo"操作，也不會有錯誤<br /> ;;By 龍龍仔(LUCAS)<br /> <br /> (defun C:LINE_REACTOR (/ HOLDECHO L1 C1)<br />   (vl-load-com)<br />   (setq HOLDECHO (getvar "CMDECHO"))<br />   (setvar "CMDECHO" 1)<br />   (command "_.LINE" PAUSE PAUSE "")<br />   (setq L1 (entlast))<br />   (command "_.CIRCLE" (getvar "LASTPOINT") PAUSE)<br />   (setq C1 (vlax-ename->vla-object (entlast)))<br />   (setvar "CMDECHO" 0)<br />   (command "_.TRIM"<br />            (entlast)<br />            ""<br />            (list L1 (getvar "LASTPOINT"))<br />            ""<br />   )<br />   (setq L1 (cdr (assoc 5 (entget L1))))<br />   (vlr-pers<br />     (vlr-object-reactor<br />       (list C1)<br />       L1<br />       '((:vlr-modified . LI))<br />     )<br />   )<br />   (setvar "CMDECHO" HOLDECHO)<br />   (princ)<br /> )<br /> (prompt "\nType LINE_REACTOR")<br /> <br /> (defun LI (NOTIFIER-OBJECT             REACTOR-OBJECT<br />            PARAMETER-LIST             /                  PTC<br />            PTR                L1             SPT          ANG<br />            DIST<br />           )<br />   (vl-load-com)<br />   (if (not (vlax-erased-p NOTIFIER-OBJECT))<br />     (progn<br />       (setq<br />         PTC (vlax-safearray->list<br />               (vlax-variant-value (vla-get-center NOTIFIER-OBJECT))<br />             )<br />       )<br />       (setq PTR (vla-get-radius NOTIFIER-OBJECT))<br />       (if (entget (setq L1 (handent (vlr-data REACTOR-OBJECT))))<br />         (progn<br />           (setq L1 (vlax-ename->vla-object L1))<br />           (setq<br />             DIST (- (distance (setq SPT        (vlax-safearray->list<br />                                           (vlax-variant-value<br />                                             (vla-get-startpoint L1)<br />                                           )<br />                                         )<br />                               )<br />                               PTC<br />                     )<br />                     PTR<br />                  )<br />           )<br />           (setq ANG (angle SPT PTC))<br />           (vla-put-endpoint L1 (vlax-3d-point (polar SPT ANG DIST)))<br />         )<br />       )<br />     )<br />   )<br />   (princ)<br /> )<br />

雪山飞狐(lzh)

不懂了，为什么不用快速引线＋块参照？

LUCAS

最初由 lzh741206 发布
[B]不懂了，为什么不用快速引线＋块参照？ [/B]

可以的話寫出來看看是否能讓直線總是通過圓心-----變動圓的位置!!

雪山飞狐(lzh)

这个不用写程序的呀!
快速引线本来就可以关联块参照

lsjjm

最初由 lzh741206 发布
[B]这个不用写程序的呀!
快速引线本来就可以关联块参照 [/B]

楼主的意思是拖动或延伸时引线的延长线始终过圆心, 恐怕不编程序办不到吧?

雪山飞狐(lzh)

明白了，是我没完全理解楼主的意思，：）
挺好玩的，贴个VBA的，：）
Sub tt()
On Error GoTo ErrHandle
Dim pLine As AcadLine
Dim pCircle As AcadCircle
p1 = ThisDrawing.Utility.GetPoint(, "输入第一点:")
p2 = ThisDrawing.Utility.GetPoint(p1, "输入第二点:")
Set pLine = ThisDrawing.ModelSpace.AddLine(p1, p2)
pdis = ThisDrawing.Utility.GetDistance(p2, "输入圆半径:")
Set pCircle = ThisDrawing.ModelSpace.AddCircle(p2, pdis)
Dim xt(1) As Integer, xd(1)
xt(0) = 1001: xd(0) = "TlsCadXHQ"
xt(1) = 1000: xd(1) = pLine.Handle
pCircle.SetXData xt, xd
ErrHandle:
End Sub

Private Sub AcadDocument_ObjectModified(ByVal Object As Object)
On Error GoTo ErrHandle
Dim pObj As AcadLine
Dim pStart, pEnd
Dim c As AcadCircle
Object.GetXData "TlsCadXHQ", xt, xd
If IsArray(xd) Then
Set pObj = ThisDrawing.HandleToObject(xd(1))
pStart = pObj.StartPoint
pEnd = Object.Center
pAngle = ThisDrawing.Utility.AngleFromXAxis(pStart, pEnd)
pdis = ((pStart(0) - pEnd(0)) ^ 2 + (pStart(1) - pEnd(1)) ^ 2) ^ 0.5 - Object.radius
pObj.EndPoint = ThisDrawing.Utility.PolarPoint(pStart, pAngle, pdis)
End If
ErrHandle:
End Sub

yanxinbo67

我用过9楼的LISP，不错。可是能否改进一下，当第二次打开图纸进行STRETCH的时候，不好用了，只有再画一个后所有的又好用了。另外能否在直线另一端加上箭头，具备同样方向跟随功能