drafter007 发表于 2022-7-6 07:48:34

ssget-再次

我想使用ssget选择围绕中心的点，其中lst是3dpoints的列表
 

      (setq ss (ssget '(
            (-4 . "<OR")
            (-4 . "<AND")
            ("_CP"lst)
            (0 . "POINT")
            (-4 . "AND>")
            (-4 . "OR>"))))

 
有什么帮助吗？谢谢

marko_ribar 发表于 2022-7-6 08:00:19


(setq ss (ssget "_CP" lst '((0 . "POINT"))))

 
M、 R。

drafter007 发表于 2022-7-6 08:10:14

不起作用。。。或者我做错了什么。。。。

drafter007 发表于 2022-7-6 08:17:33

我又错了，还好。。。谢谢

drafter007 发表于 2022-7-6 08:31:23

我试着在调查的3个点之间做一个“插值”。我的意思是，在由3个点（测量点）定义的平面上找到一个点的高程。这就是我现在拥有的，仍在工作，看起来很糟糕。。。。很抱歉。也许有人有一些类似的东西，或一些链接，或一些想法如何使它更简单-当然可以做得更好。谢谢
 

(defun c:Z3( /   te sizetext oldEcho oldosmode
       p1 p2 p3 linie ppt z )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun LM:GetIntersections ( obj1 obj2 )
(LM:GroupByNum (vlax-invoke obj1 'IntersectWith obj2 acExtendBoth) 3)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun LM:GroupByNum ( l n / r)
(if l
   (cons
   (reverse (repeat n (setq r (cons (car l) r) l (cdr l)) r))
   (LM:GroupByNum l n)
   )
)
)      
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(vl-load-com)
   (defun *error* (msg)
   (and uFlag (vla-EndUndoMark aDoc))
   (and msg (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
                (princ (strcat "\n** Error: " msg " **"))))
   (princ))
(setq aDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
(setq uFlag (not (vla-StartUndoMark aDoc)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setvar "dimdec" 3)
(princ "\nSELECTEAZA TEXT PENTRU MARIME CARACTERE")
(if(setq te (entsel))
(setq sizetext (cdr(assoc 40 (entget(car te))))))
(if (=te nil)(setq sizetext 5))
(setq oldEcho(getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(setq oldosmode (getvar "OSMODE"))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setvar "OSMODE" 512)
(princ "\nSELECTEAZA PUNCT")
(if
   (setq p1 (getpoint "\nPOINT1")
       p2 (getpoint "\nPOINT 2")
       p3 (getpoint "\nPOINT 3")
       pc (getpoint "\nPOINT UNKNOWN"))   
   (progn
      (setvar "OSMODE" 9)
      (SETVAR "CECOLOR" "232")
      (command "_.line" p1 p2 "")
      (setq l12 (entlast))
      (command "_.line" p1 p3 "")
      (setq l13 (entlast))
      (command "_.line" p2 p3 "")
      (setq l23 (entlast))
      (command "_.line" p1 pc "")
      (setq lc (entlast))
      (setq x1 (car p1)
      x2 (car p2)
      x3 (car p3)
      xc (car pc)
      y1 (cadr p1)
      y2 (cadr p2)
      y3 (cadr p3)
      yc (cadr pc)
      z1 (caddr p1)
      z2 (caddr p2)
      z3 (caddr p3)   
   )
   (command "_.line" (list x2 y2 0) (list x3 y3 0) "")
   (setq l23p (entlast))
   (command "_.line" (list x1 y1 0) (list xc yc 0) "")
   (setq lp (entlast))
   (setq pint0 (LM:GetIntersections (vlax-ename->vla-object l23p) (vlax-ename->vla-object lp)))
   (setq pint0 (list (caar pint0) (cadr (car pint0)) (caddr (car pint0))))
   (command "_.line" pint0(list (car pint0) (cadr pint0) 10.0) "")
   (setq lint (entlast))
   (setq pint (LM:GetIntersections (vlax-ename->vla-object lint) (vlax-ename->vla-object l23)))
   (setq pint (list (caar pint) (cadr (car pint)) (caddr (car pint))))
   (command "_.line" p1 pint "")
   (setq lcf (entlast))
   (command "_.line" pc (list (car pc) (cadr pc) 10.0) "")
   (setq laj (entlast))
   (setq pcf (LM:GetIntersections (vlax-ename->vla-object laj) (vlax-ename->vla-object lcf)))
   (setq pcf (list (caar pcf) (cadr (car pcf)) (caddr (car pcf))))
   (setq z (rtos (caddr pcf) 2 3))
   (command "_.point" pcf)
   (command "text"pcfsizetext "0" (strcat "" z))
   (command "_.erase" l12 l13 l23 lc l23p lp lint lcf laj "")
   (SETVAR "CECOLOR" "BYLAYER")
    ); end progn
);end if
      (setvar "CMDECHO" oldEcho)
      (setvar "OSMODE" OLDOSMODE)
      (setvar "dimdec" 2)
(*error* nil)
(princ)
)

marko_ribar 发表于 2022-7-6 08:32:30

试试这个：
 

;; Line-Plane Intersection-Lee Mac
;; Returns the point of intersection of a line defined by
;; points p1,p2 and a plane defined by its origin and normal
(defun LM:IntersLinePlane ( p1 p2 org nm )
   (setq org (trans org 0 nm)
         p1(trans p10 nm)
         p2(trans p20 nm)
   )
   (trans
       (inters p1 p2
         (list (car p1) (cadr p1) (caddr org))
         (list (car p2) (cadr p2) (caddr org))
         nil
       )
       nm 0
   )
)
;; Vector Cross Product-Lee Mac
;; Args: u,v - vectors in R^3
(defun v^v ( u v )
   (list
       (- (* (cadr u) (caddr v)) (* (cadr v) (caddr u)))
       (- (* (carv) (caddr u)) (* (caru) (caddr v)))
       (- (* (caru) (cadrv)) (* (carv) (cadru)))
   )
)
;; Unit Vector-Lee Mac
;; Args: v - vector in R^2 or R^3
(defun v1 ( v )
   (   (lambda ( n ) (if (equal 0.0 n 1e-10) nil (mapcar '/ v (list n n n))))
       (distance '(0.0 0.0 0.0) v)
   )
)
(defun c:Z3 ( / p1 p2 p3 pc pcv norvec1plane pcc z )
(setq p1 (getpoint "\nPick first plane point : ")
       p2 (getpoint "\nPick second plane point : ")
       p3 (getpoint "\nPick third plane point : ")
       pc (getpoint "\nPick 2d point to project it to plane : ")
)
(setq pcv (list (car pc) (cadr pc) (+ (caddr pc) 1.0)))
(setq norvec1plane (v1 (v^v (mapcar '- p3 p1) (mapcar '- p2 p1))))
(setq pcc (LM:IntersLinePlane pc pcv p1 norvec1plane))
(setq z (rtos (caddr pcc) 2 3))
(command "_.point" pcc)
(command "text" pcc 5.0 "0" (strcat "" z))
(princ)
)

 
M、 R。

brams 发表于 2022-7-6 08:41:22

干杯，马可！

drafter007 发表于 2022-7-6 08:55:20

太好了，谢谢！
页: [1]
查看完整版本: ssget-再次