ChrisCMU 发表于 2022-7-6 12:21:14

由质心偏移-需要帮助

我试图在用户选择的一组多条直线内自动创建多段线(注意:直线始终在端点相交,因此此处不包含错误检查,但应在某个点添加错误检查)。
 
它调用了我在这里找到的get centroid函数(以获取要偏移的边):
问题是,它会提示我选择要作为中心的多段线(在get-centroid函数中应该这样做),但我希望将变量“last”传递给它,而不是提示。不管我做什么,我都不能让它工作。如果我实际键入“l”,它将选择创建的多段线并继续,但我希望在选择初始线后自动执行。有什么想法吗?

alanjt 发表于 2022-7-6 12:25:26

未经测试,但请尝试替换此行:
(vla-getentity util 'plineObj 'pickPt "\nSelect a polyline:\n")
有了这个:
(setq plineObj (vlax-ename->vla-object (entlast)))
 
我强烈建议您在质心子例程中定位变量。

ChrisCMU 发表于 2022-7-6 12:28:53

非常好,谢谢。我不擅长vla命令,不知道该怎么办。再次感谢。

gile 发表于 2022-7-6 12:33:51

你好
 
这里有另一种获取多段线质心的方法(接受带弧段的多段线)。
根据我做的基准测试,它的运行速度大约是需要建模器的“区域声明”的3倍。
 
;; ALGEB-AREA
;; Returns the algebraic area of the triangle defined by three 2d points
;; the area is negative if points are clockwise

(defun algeb-area (p1 p2 p3)
(/ (-        (* (- (car p2) (car p1))
   (- (cadr p3) (cadr p1))
)
(* (- (car p3) (car p1))
   (- (cadr p2) (cadr p1))
)
    )
    2.0
)
)

;; TRIANGLE-CENTROID
;; Returns the centroid of a triangle defined by 3 points

(defun triangle-centroid (p1 p2 p3)
(mapcar '(lambda (x1 x2 x3)
   (/ (+ x1 x2 x3) 3.0)
   )
p1
p2
p3
)
)

;; POLYARC-CENTROID
;; Returns a list which first item is the centroid of a 'polyarc'
;; and the second its algeraic area
;;
;; Arguments
;; bu : polyarc bulge
;; p1 : start point
;; p2 : end point

(defun polyarc-centroid        (bu p1 p2 / ang rad cen area dist cg)
(setq        ang(* 2 (atan bu))
rad(/        (distance p1 p2)
        (* 2 (sin ang))
   )
cen(polar p1
          (+ (angle p1 p2) (- (/ pi 2) ang))
          rad
   )
area (/ (* rad rad (- (* 2 ang) (sin (* 2 ang)))) 2.0)
dist (/ (expt (distance p1 p2) 3) (* 12 area))
cg   (polar cen
          (- (angle p1 p2) (/ pi 2))
          dist
   )
)
(list cg area)
)

;; PLINE-CENTROID
;; Returns the WCS coordinates of a lwpolyline centroid
;;
;; Argument
;; pl : the lwpolyline ename

(defun pline-centroid (pl / elst lst tot cen p0 area cen)
(setq elst (entget pl))
(while (setq elst (member (assoc 10 elst) elst))
   (setq lst(cons (cons (cdar elst) (cdr (assoc 42 elst))) lst)
elst (cdr elst)
   )
)
(setq        lst (reverse lst)
tot 0.0
cen '(0.0 0.0)
p0(caar lst)
)
(if (/= 0 (cdar lst))
   (setq p-c (polyarc-centroid (cdar lst) p0 (caadr lst))
cen (mapcar '(lambda (x) (* x (cadr p-c))) (car p-c))
tot (cadr p-c)
   )
)
(setq lst (cdr lst))
(if (equal (car (last lst)) p0 1e-9)
   (setq lst (reverse (cdr (reverse lst))))
)
(while (cadr lst)
   (setq area (algeb-area p0 (caar lst) (caadr lst))
cen(mapcar '(lambda (x1 x2) (+ x1 (* x2 area)))
             cen
             (triangle-centroid p0 (caar lst) (caadr lst))
       )
tot(+ area tot)
   )
   (if        (/= 0 (cdar lst))
   (setq p-c        (polyarc-centroid (cdar lst) (caar lst) (caadr lst))
    cen        (mapcar        '(lambda (x1 x2) (+ x1 (* x2 (cadr p-c))))
                cen
                (car p-c)
        )
    tot        (+ tot (cadr p-c))
   )
   )
   (setq lst (cdr lst))
)
(if (/= 0 (cdar lst))
   (setq p-c (polyarc-centroid (cdar lst) (caar lst) p0)
cen (mapcar '(lambda (x1 x2) (+ x1 (* x2 (cadr p-c))))
              cen
              (car p-c)
      )
tot (+ tot (cadr p-c))
   )
)
(trans (list (/ (car cen) tot)
       (/ (cadr cen) tot)
       (cdr (assoc 38 (entget pl)))
)
pl
0
)
)

ChrisCMU 发表于 2022-7-6 12:36:37

好吧,它又不起作用了。我不得不做一些调整,因为我发现如果您选择的原始线已经是多段线,该程序无法工作,因为它不会选择正确的最后一个图元(除非连接的多段线来自直线,否则它不会将连接的多段线视为最后一个)。
 
因此,我试图修改它,根本不使用last(而是将线发送到一个新层,由其属性选择)。出于某种原因,get centroid函数不接受我试图传递给它的值。
 
 
吉尔-我试过你的,但根本不起作用。我甚至注释掉了entget部分并将其编码为ssget,在手动选择后,它没有正常工作。

gile 发表于 2022-7-6 12:40:02

 
例行程序确实有效,您可以尝试以下方法:
但使用pline质心并不能确保在多段线内偏移。
多段线质心可能位于多段线之外:

gile 发表于 2022-7-6 12:41:26

使用闭合多段线的vla偏移功能可以确保“insde偏移”。
 
vla偏移函数的帮助文件说:
偏移对象的距离。偏移量可以是正数或负数,但不能等于零。如果偏移量为负数,则将其解释为生成“较小”曲线的偏移量。
 
对于闭合多段线,如果多段线为逆时针方向,则为真;如果多段线为顺时针方向,则为逆时针方向。
一种知道pline是否顺时针或逆时针的方法是计算其代数面积:负面积表示pline是顺时针的。
 
InsideOffset例程需要两个参数:多段线(ename或vla对象)和偏移距离(正实数)。
 
您可以使用:(InsideOffset(car(enstel)))进行测试
 
;; PLINE-ALGEBRAIC-AREA (gile)
;; Returns the algebraic area of the polyline
;; the area is negative if the polyline is clockwise
;;
;; Argument: a polyline ename

(defun Pline-Algebraic-Area (pl / elst lst tot)
(setq elst (entget pl))
(while (setq elst (member (assoc 10 elst) elst))
   (setq lst(cons (cons (cdar elst) (cdr (assoc 42 elst))) lst)
   elst (cdr elst)
   )
)
(setq    lst (reverse lst)
   tot 0.0
   p0(caar lst)
)
(if (/= 0 (cdar lst))
   (setq tot (polyarc-algeb-area (cdar lst) p0 (caadr lst))
   )
)
(setq lst (cdr lst))
(if (equal (car (last lst)) p0 1e-9)
   (setq lst (reverse (cdr (reverse lst))))
)
(while (cadr lst)
   (setq tot(+ (triangle-algeb-area p0 (caar lst) (caadr lst)) tot))
   (if    (/= 0 (cdar lst))
   (setq tot    (+ tot (polyarc-algeb-area (cdar lst) (caar lst) (caadr lst))))
   )
   (setq lst (cdr lst))
)
(if (/= 0 (cdar lst))
   (setq tot (+ tot (polyarc-algeb-area (cdar lst) (caar lst) p0)))
)
tot
)

;; TRIANGLE-ALGEB-AREA (gile)
;; Returns the algebraic area of the triangle defined by three 2d points
;; the area is negative if points are clockwise
;;
;; Arguments: three 2d points

(defun triangle-algeb-area (p1 p2 p3)
(/ (-    (* (- (car p2) (car p1))
      (- (cadr p3) (cadr p1))
   )
   (* (- (car p3) (car p1))
      (- (cadr p2) (cadr p1))
   )
    )
    2.0
)
)

;; POLYARC-ALGEB-AREA (gile)
;; Returns the algeraic area of a 'polyarc'
;;
;; Arguments
;; bu : polyarc bulge
;; p1 : start point
;; p2 : end point

(defun polyarc-algeb-area    (bu p1 p2 / ang rad)
(setq    ang(* 2 (atan bu))
   rad(/    (distance p1 p2)
       (* 2 (sin ang))
      )
)
(/ (* rad rad (- (* 2 ang) (sin (* 2 ang)))) 2.0)
)

;; InsideOffset (gile)
;; Offset inside a closed polyline
;;
;; Arguments
;; pl: a polyline (ename or vla-object)
;; dist: offset distance
;;
;; Returns a variant
;; (an array of the newly created objects resulting from the offset).

(defun InsideOffset (pl dist / obj)
(vl-load-com)
(if (= (type pl) 'ENAME)
   (setq obj (vlax-ename->vla-object pl))
   (setq obj pl
         pl(vlax-vla-object->ename obj)
   )
)
(vla-offset obj
             (if (minusp (Pline-Algebraic-Area pl))
               dist
               (- dist)
             )
)
)

alanjt 发表于 2022-7-6 12:45:21

我只是好奇你是否可以完成这个不计算代数面积的任务。这只是一个概念证明;想玩一会儿。
;;; Offset inside of selected objects
;;; Alan J. Thompson, 09.12.09
(defun c:OffIn (/ #Dist #SSGet #Pline #Offset)
(vl-load-com)
(initget 6)
(cond
   ((and (setq #Dist (getdist "\nSpecify offset distance: "))
         (setq #SSGet (ssget ":L" '((0 . "LINE,LWPOLYLINE,ARC"))))
    ) ;_ and
    (if (zerop (getvar "peditaccept"))
      (vl-cmdf "_.pedit" "_m" #SSGet "" "_y" "_j" "" "")
      (vl-cmdf "_.pedit" "_m" #SSGet "" "_j" "" "")
    ) ;_ if
    (if (not (vl-catch-all-error-p
               (setq
               #Offset
                  (vl-catch-all-apply
                  'vla-offset
                  (list (setq
                            #Pline (vlax-ename->vla-object (entlast))
                        ) ;_ setq
                        (abs #Dist)
                  ) ;_ list
                  ) ;_ vl-catch-all-apply
               ) ;_ setq
             ) ;_ vl-catch-all-error-p
      ) ;_ not
      (if (> (vla-get-area
               (setq #Offset (car (vlax-safearray->list
                                    (vlax-variant-value #Offset)
                                  ) ;_ vlax-safearray->list
                           ) ;_ car
               ) ;_ setq
             ) ;_ vla-get-area
             (vla-get-area #Pline)
          ) ;_ >
      (progn
          (vla-delete #Offset)
          (if (not (vl-catch-all-error-p
                     (setq #Offset (vl-catch-all-apply
                                     'vla-offset
                                     (list #Pline (- (abs #Dist)))
                                 ) ;_ vl-catch-all-apply
                     ) ;_ setq
                   ) ;_ vl-catch-all-error-p
            ) ;_ not
            (setq #Offset (car (vlax-safearray->list
                                 (vlax-variant-value #Offset)
                               ) ;_ vlax-safearray->list
                        ) ;_ car
            ) ;_ setq
            (setq #Offset nil)
          ) ;_ if
      ) ;_ progn
      ) ;_ if
      (alert "Item cannot be offset.")
    ) ;_ if
    (and #Pline (vla-explode #Pline))
   )
) ;_ cond
(princ)
) ;_ defun

jaiganesh 发表于 2022-7-6 12:46:59

尊敬的alanjt,
 
你能解释一下获取偏移多段线的内部点的步骤或基本思想吗?你的lisp很好,但我不明白它是怎么工作的?

alanjt 发表于 2022-7-6 12:51:11

没问题。
它所做的只是将pline偏移非常小的距离。如果偏移pline的面积大于原始pline的面积,则删除新pline,并在另一个方向偏移原始pline。这是为了在原稿中得到一条普林线。一旦完成,它只需从新普林线坐标中提取第一个点。从而返回原始pline内的点。
页: [1] 2
查看完整版本: 由质心偏移-需要帮助