Jimforbz 发表于 2022-7-6 07:22:42

拾取切点时出现问题

你好
 
我是这个论坛的新手,但我想知道是否有人有同样的问题。。
 
背景-我写了一个快速的lisp来尝试和自动化我经常执行的一项常见任务。基本上,我是通过从3个已知点画3个圆来画一个圆的,也就是说,如果你在一个房间里,想画一个圆柱,我能找到的最简单的方法是用3个切点画一个圆-(在建筑环境中,使用手持仪器测量直径或周长通常非常不准确)。
 
问题是,当您出于某种原因将OSMODE设置为256时,它不允许您拾取切点!!-至少不是我想要选择的,也绝对不是在lisp之外使用圆形命令时可用的。
我甚至在每次需要选取切点时都尝试重新设置它。
 
请任何人帮忙。非常感谢。
 
P、 这是我想出的代码。。。
(请注意:我还没有找到删除初始圆的方法,我还需要输入到柱的测量距离作为我现场工作的记录-但首先-我需要找出切线不起作用的原因!!)
 

(defun c:column ()
(setq oldcmdecho (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq oldosmode (getvar "osmode"))
(setvar "osmode" 35)
(setq oldcmddia (getvar "cmddia"))
(setvar "cmddia" 0)
(princ "n\ Draws circular column using 3 reference points")
;draw initial 3 circles using user input

(initget 1)(setq orig1pt (getpoint "\n Select origin of measurement..."))
(setq circ1rad (getreal "\n Input distance from disto..."))
(command "circle" orig1pt circ1rad )
(initget 1)(setq orig2pt (getpoint "\n Select origin of measurement..."))
(setq circ2rad (getreal "\n Input distance from disto..."))
(command "circle" orig2pt circ2rad )
(initget 1)(setq orig3pt (getpoint "\n Select origin of measurement..."))
(setq circ3rad (getreal "\n Input distance from disto..."))
(command "circle" orig3pt circ3rad )
;draw column with 3 tangent points
(setvar "osmode" 256)
(initget 1)(setq col1pt1 (getpoint "\n Select tangent on first circle nearest where column will be placed..."))
(setvar "osmode" 256)
(initget 1)(setq col1pt2 (getpoint "\n Select tangent on second circle nearest where column will be placed..."))
(setvar "osmode" 256)
(initget 1)(setq col1pt3 (getpoint "\n Select tangent on third circle nearest where column will be placed..."))
(command "circle" "3p" col1pt1 col1pt2 col1pt3 )

(setvar "osmode" oldosmode )
(setvar "cmdecho" oldcmdecho )
(setvar "cmddia" oldcmddia)
(princ)
)

CAB 发表于 2022-7-6 07:32:26

您是否可以发布一个显示所需方法的之前、期间和之后的DWG。我很难想象你在做什么。

BlackAlnet 发表于 2022-7-6 07:36:00

我认为,问题是:你没有一个参考点。

Jimforbz 发表于 2022-7-6 07:42:19

我已按要求附上exmaple图纸。
现场测量柱。图纸

CAB 发表于 2022-7-6 07:46:06

这是第1版&需要做更多的工作,但展示了如何通过试错来完成。
 
;;CAB Version 1.0The Sledge Hammer Approach
;; Perhaps someone with a math background can apply the Math solution
;;http://demonstrations.wolfram.com/CirclesOfApollonius/
;;http://www.geometryexpressions.com/downloads/Circles.pdfexample 86

(defun c:GetColumn (/ p1 p2 p3 r1 r2 r3 c1 c2 c3 rbase rinc fuzz
                   cpt pts_c1_c2 pts_c2_c3 pts_c1_c3)
(vl-load-com)
(defun MakeCircle (cpt rad lay)
   (entmakex
   (list (cons 0 "CIRCLE")
         (cons 6 "BYLAYER")
         (cons 8 "0")
         (cons 10 cpt)
         (cons 39 0.0)
         (cons 40 rad)   ; radius
         (cons 62 256)
         (cons 210 (list 0.0 0.0 1.0))
   )
   )
)

;;return 2 points in a list
(defun getinters (obj1 obj2)
   (setq iplist (vl-catch-all-apply
                  'vlax-safearray->list
                  (list (vlax-variant-value
                        (vla-intersectwith obj1 obj2 acextendnone)
                        )
                  )
                )
   )
   (if (vl-catch-all-error-p iplist) ;error if no intersection
   nil
   (list (list (car iplist)(cadr iplist))(list (cadddr iplist)(nth 4 iplist)))
   )
)

(if (or p1 ; debug
   (and (setq p1 (getpoint "\nPick First circle center point."))
          (setq r1 (getdist "\nEnter distance to column.") rx1 r1)
          (setq p2 (getpoint "\nPick Second circle center point."))
          (setq r2 (getdist "\nEnter distance to column.") rx2 r2)
          (setq p3 (getpoint "\nPick Third circle center point."))
          (setq r3 (getdist "\nEnter distance to column.") rx3 r3)
)
   )
   (progn
   (setq r1 rx1 r2 rx2 r3 rx3) ; debug
   (setq rbase r1
         rinc0.01 ; step size
         fuzz0.01)
   (setq c1 (vlax-ename->vla-object (MakeCircle p1 r1 "0")))
   (setq c2 (vlax-ename->vla-object (MakeCircle p2 r2 "0")))
   (setq c3 (vlax-ename->vla-object (MakeCircle p3 r3 "0")))
   (while
       (progn
       (vla-put-radius c1 (setq r1 (+ r1 rinc)))
       (vla-put-radius c2 (setq r2 (+ r2 rinc)))
       (vla-put-radius c3 (setq r3 (+ r3 rinc)))
      (cond
         ((null (setq pts_c1_c2 (getinters c1 c2)))
          (prompt "\nC1 & C2 do not intersect.")
         )
         ((null (setq pts_c2_c3 (getinters c2 c3)))
          (prompt "\nC2 & C3 do not intersect.")
         )
         ((null (setq pts_c1_c3 (getinters c1 c3)))
          (prompt "\nC1 & C3 do not intersect.")
         )

         ;;if 3 of the 6 points are the same the center has been found
         ;;check the first 2 point pair against the remaining two pair
         ((vl-some '(lambda(x); 5.77522
                      (and
                            (or (equal x (car pts_c2_c3) fuzz)
                              (equal x (cadr pts_c2_c3) fuzz))
                            (or (equal x (car pts_c1_c3) fuzz)
                              (equal x (cadr pts_c1_c3) fuzz))))
                   pts_c1_c2)
          (MakeCircle (car pts_c1_c2) (- r1 rbase) "0")
          nil ; exit loop
         )
         (t t)
       )
       )
   )
   )
)
(princ)
)

Jimforbz 发表于 2022-7-6 07:50:22

嗨,驾驶室
 
感谢您的回复和对我延迟(我上周不在)的申请。
 
我已经尝试了数学,但我的知识在重新排列复杂的二次方程时遇到了障碍,当试图操作笛卡尔坐标时。
我知道一定有办法解决这个问题,因为AuotCAD已经包含了这种能力。然而,我无法理解。
 
我现在意识到getpoint只存储一个点,而不是连接到圆弧或圆周围点的切线数据。
 
无论如何,非常感谢你的输入和链接(它们非常有用-我在这里写博客之前也找到了“ttt.zip”,它试图使用相同的原则),但我想我必须离开这里,给这一些更详细的思考/数学,也许再把它搞糟一些。
 
ttt。拉链

ronjonp 发表于 2022-7-6 07:55:25

这里有一些东西可以帮助放置圆。。。如果您不介意精度为1\100,那么它应该可以正常工作。所有这些几何问题都让我头疼,所以我采取了像CAB这样的野蛮方法

;;; AUTHOR
;;; Copyright© 2009 Ron Perez (ronperez (AT) gmail dot com)
;;;

(defun c:tancir    (/ c1 c2 c3 cen circle d1 d2 d3 fuzz p rad ss)
(vl-load-com)
(princ "\nSelect 3 circles...")
(if (and (setq ss (ssget '((0 . "CIRCLE"))))
      (setq c1 (ssname ss 0))
      (setq c2 (ssname ss 1))
      (setq c3 (ssname ss 2))
      (setq fuzz 0.01)
   )
   (while (and (setq p (grread 5)) (= (car p) 5) (setq cen (trans (cadr p) 1 0)))
   (redraw)
   (grdraw cen (setq d1 (vlax-curve-getclosestpointto c1 cen)) 1)
   (grdraw cen (setq d2 (vlax-curve-getclosestpointto c2 cen)) 2)
   (grdraw cen (setq d3 (vlax-curve-getclosestpointto c3 cen)) 3)
   (setq rad (/ (apply '+ (list (distance cen d1) (distance cen d2) (distance cen d3))) 3.))
   (if circle
   (entdel circle)
   )
   (setq circle (entmakex (list '(0 . "CIRCLE")
                  '(6 . "BYLAYER")
                  '(8 . "0")
                  (cons 10 cen)
                  '(39 . 0.0)
                  (cons 40 rad) ; radius
                  '(62 . 256)
                  (cons 210 (list 0.0 0.0 1.0))
                )
          )
   )
   (if (and (equal rad (distance cen d1) fuzz)
          (equal rad (distance cen d2) fuzz)
          (equal rad (distance cen d3) fuzz)
   )
   (progn (grdraw cen (vlax-curve-getclosestpointto c1 cen) 5)
          (grdraw cen (vlax-curve-getclosestpointto c2 cen) 5)
          (grdraw cen (vlax-curve-getclosestpointto c3 cen) 5)
   )
   )
   (princ)
   )
)
)

CALCAD 发表于 2022-7-6 08:01:54

这是我对Jimforbz提出的相切问题的迟来的回应。
对这个问题的研究使我了解了一些古代和近代的历史,研究了阿波罗相切问题的各种解决方案。该程序解决了一种相切问题,这只是寻找所有与三个给定圆相切的圆的一般问题的一小部分。编写和测试非常有趣。实际上有两个程序。在运行之前,请阅读代码前面的所有注释。享受
 
3)
 
 
;DAIC.LSPProgram to delete entities generated by AIC
;          on the AIC layer.

; 7-31-09Working version by CALCAD

(defun c:daic (/ vcset n ssln vc_en)
(setq vcset (ssget "X" '((8 . "AIC")))) ; select all entities on AIC layer
(if (/= vcset nil)
(progn
   (setq n 0)
   (setq ssln 0)
   (setq ssln (sslength vcset))
   (repeat ssln
   (setq vc_en (ssname vcset n))
   (entdel vc_en)
   (setq n (+ n 1))
   )
)
)
(setq vcset nil)
(princ)
)

CAB 发表于 2022-7-6 08:03:59

吉姆,
你所需要的就是柱的周长&中心可以计算出来。
 
5

CALCAD 发表于 2022-7-6 08:09:59

美好的男孩,我是不是想太多了
页: [1] 2
查看完整版本: 拾取切点时出现问题