如何添加修改此代码以优先考虑暗线与对象的距离?

问题描述 投票:0回答:0

代码只计算到暗线直接附着的物体的距离。我希望它以某种方式将物体内部的孔等物体的距离设置为距物体 200 毫米(比例为 1:10),而不是直接距孔 200 米。以某种方式使暗线和对象的交点成为对象内部对象的基础。

(defun c:DLA ( / sel ent txp al ar mp uALR s txpp uvt tp exss exssent exssl exssindex)

(defun deg2rad (ang / )
  (/ (* PI ang) 180.0)
)

(defun rad2deg ( ang / )
  (/ (* 180.0 ang) PI)
)

;; midpoint of 2 given points
(defun mid ( pt1 pt2 / )
  (mapcar '(lambda (x y) (+ (* 0.5 x) (* 0.5 y)))
  pt1
  pt2
  )
)

;;;  Calculate unit vector of vector a 
(defun uvec 
  (a / d)
  (setq d (distance '(0 0 0) a)
    a (mapcar '/ a (list d d d))
  )
)

; Compute the dot product of 2 vectors a and b
(defun dot ( a b / dd)
  (setq dd (mapcar '* a b))
  (setq dd (+ (nth 0 dd) (nth 1 dd) (nth 2 dd)))
)                   ;end of dot  

  (princ "\nInput Desired Distance: ")
  (setq dist (getreal))
  
  (princ "\nSelect Dimension(s) To Change: ")  
  
    (setq exss (ssget '((0 . "*dim*"))))                           
    (setq exssl (sslength exss))                                   
    (setq exssindex 0) 
    
    (repeat exssl                                                    
        (setq exssent (entget (ssname exss exssindex)))              

         (setq ent (cdr (car exssent)))                                 
         (setq txp (cdr (assoc 10 (entget ent))))
         (setq al (cdr (assoc 13 (entget ent))))
         (setq ar (cdr (assoc 14 (entget ent))))

         (setq mp (mapcar '/
                     (mapcar '+ al ar)
             '(2. 2. 2.)
             )
         )

        ; uALR = unit vector from al to ar
        (setq uALR (uvec (mapcar '- ar al)))
        (setq s (dot uALR (mapcar '- txp al)))
        
        ; txpp = projection of txp onto the line    
        (setq txpp
               (mapcar '+ al (mapcar '* uALR (list s s s)))
        )
        
        (setq uvt (uvec (mapcar '- txp txpp)))
        (setq tp (mapcar '+ mp (mapcar '* uvt (list dist dist dist))))
        
        (entmod
          (subst (cons 10 tp) (assoc 10 (entget ent)) (entget ent))
        )
        
        (entmod
          (subst (cons 11 tp) (assoc 11 (entget ent)) (entget ent))
        )

         
         (setq exssindex (+ exssindex 1))     
    )
    
(princ)

)

lisp autocad autolisp
© www.soinside.com 2019 - 2024. All rights reserved.