Selecting a line through a point?

[saitoib]

Hi all

Attached Lisp program does not work well
When you select two lines, the program changes the layer of the selected lines, creates middle lines, and trims perpendicular lines at the middle spine.
From image A to image B
However, if the distance between the two lines is 0.05 or less, only the middle line is displayed.
From image C to image D
Now, in line 108 of the program, nn is 3 for image A, but 5 for image C.
Also, if the rectangle is 30, even if the line spacing is 0.05, it will behave as expected.
From image E to image F

What is the cause of this?
How should I take measures?

Thank you very much.

(defun c:test
  ( / prod ent1 ent2 p1s p1e p2s p2e p3s p3e
    dist1 dist2 ip dv1 dv2 tmp ed1 ed2 ed3
    newlayer oldlayer newltype oldltype ent3 ss nn)

  (setq prod (strcase (getvar 'product)));Product determination

  (if (setq ent1 (car (entsel "Select \n1st line"))) ;Select target line segment car=list first element
    (progn ;if no multiple lines
      (redraw ent1 3)
      (if (setq ent2 (car (entsel "\n2th line selected")))
        (redraw ent2 3)
        (progn (redraw ent1 4) (quit))
      )
    )
    (quit)
  )
  
  ;Get the start and end points of a line
  (setq p1s (cdr (assoc 10 (entget ent1)))) ;1st line start point e.g. (10 0 0 0)
  (setq p1e (cdr (assoc 11 (entget ent1)))) ;1st run end point (11 200 0 0 0)
  (setq p2s (cdr (assoc 10 (entget ent2)))) ;2nd run start point (10 0 50 0)
  (setq p2e (cdr (assoc 11 (entget ent2)))) ;second run end point (11 200 50 0)
  
  ;If ent1 and ent2 have different lengths, split the longer one
  (setq dist1 (distance p1s p1e))
  (setq dist2 (distance p2s p2e))
  ;---------------------------------  Set the longer side to ent1 p1s p1e
  (if (< dist1 dist2)
    (setq tmp ent1 ent1 ent2 ent2 tmp; make long side ent1,p1s,p1e
      tmp p1s p1s p2s p2s tmp tmp p1e p1e p2e p2e tmp )
  )
  (setq ent1 (_longer_divide ent1 p1s p1e p2s p2e));ent1,p1s,p1e is long
  (setq ent1 (entlast));after splitting the long edge, newly drawn line to ent1
  (setq p1s (cdr (assoc 10 (entget ent1)))) ;1st line start point update
  (setq p1e (cdr (assoc 11 (entget ent1)))) ;1st line end point update
  ;-------------------------- where two sides of the same length are created
  
  ;align start and end points in the same direction (find inner product of vectors and determine +-)
  (setq dv1 (mapcar '- p1e p1s));(-100 0 0)
  (setq dv2 (mapcar '- p2e p2s));(96 0 0)
  (setq ip (apply '+ (mapcar '* dv1 dv2)));-9600 sum of apply list
  (if (< ip 0.0) (setq tmp p2s p2s p2e p2e tmp));exchange start and end points

  ;Change line type line color on 2 sides
  (setq ed1 (entget ent1))
  (setq ed1 (subst (cons 8 "2") (assoc 8 ed1) ed1))
  (entmod ed1)
  (setq ed2 (entget ent2))
  (setq ed2 (subst (cons 8 "2") (assoc 8 ed2) ed2))
  (entmod ed2)

  ; Find the start and end points of the bend line (center line)
  (setq p3s (mapcar '+ p1s p2s))
  (setq p3s (mapcar '/ p3s '(2.0 2.0 2.0))) 
  (setq p3e (mapcar '+ p1e p2e))
  (setq p3e (mapcar '/ p3e '(2.0 2.0 2.0)))

  ;Bend line (center line) drawing
  (setq oldlayer (_chng_layer "2"));common lisp
  (setq oldltype (_chng_ltype "CENTER"));common lisp
 
  (setvar "cmdecho" 0)
  (if (= prod "BRICSCAD")
    (command "zoom" "ob" ent1 "")
    (command "zoom" "o" ent1 "");zoom on selected object
  )
 
  (command "line" "_non" p3s "_non" p3e "")
  ;If you don't put "_non", object snap won't work.

  (_chng_ltype oldltype)
  (_chng_layer oldlayer)
  ; Unhighlight
  (redraw ent1 4)
  (redraw ent2 4)

  ; trim intersection with centerline
  ; trim exterior lines to centerline Complete for 2 sides
  (setq ent3 (entlast)) ;centerline to en3
  (_ctrim ent3 p3s p1s p2s)
  (_ctrim ent3 p3e p1e p2e)
  
  (command "._layer" "on" "2" "")
  (command "zoom" "p")
  (setvar "cmdecho" 1)
  (princ)
)

;==============================================
; long edge division subroutine
; ent1,p1s,p1e are long edge
;After dividing and deleting the long side by the width of the short side, the remaining line is drawn.
(defun _longer_divide (ent1 p1s p1e p2s p2e / ang p3s p3e)
  (setq ang (+ (angle p2s p2e) (/ pi 2))); p2+90
  (setq p3s (inters p1s p1e p2s (polar p2s ang 1) nil));intersection of long side and short side p2s perpendicular
  (setq p3e (inters p1s p1e p2e (polar p2e ang 1) nil));intersection of long and short p2e perpendiculars
  (command "_break" ent1 p3s p3e);divide and delete long side by short side width
  (command "_line" p3s p3e "");Draw a rest line
  ent1
)

; ================================================ Trim with centerline
; Trim one side outline of a face with a centerline
(defun _ctrim (cid pc p1 p2 / pc1 pc2 ss nn i id ent val)
  (setq ss (ssget "_C" pc pc)); through endpoint, intersection selection
  (setq nn (sslength ss))
  (setq i 0)
  (repeat nn
    (setq id (ssname ss i))
    (if (not (eq id cid))
      (progn
        (setq ent (entget id))
        (if (equal p1 (cdr (assoc 10 ent)) 0.000001)
          (progn
            (setq ent (subst (cons 10 pc) (assoc 10 ent) ent))
            (entmod ent)
          )
        )
        (if (equal p1 (cdr (assoc 11 ent)) 0.000001)
          (progn
            (setq ent (subst (cons 11 pc) (assoc 11 ent) ent))
            (entmod ent)
          )
        )
        (if (equal p2 (cdr (assoc 10 ent)) 0.000001);
          (progn
            (setq ent (subst (cons 10 pc) (assoc 10 ent) ent))
            (entmod ent)
          )
        )
        (if (equal p2 (cdr (assoc 11 ent)) 0.000001)
          (progn
            (setq ent (subst (cons 11 pc) (assoc 11 ent) ent))
            (entmod ent)
          )
        )
      )
    )
    (setq i (1+ i))
  )
) 

;;================================================
;; Layer change common
;; Argument : Layer name to be changed
;; Return value : current layer name
(defun _chng_layer
  (newlayer / oldlayer)
  (setq oldlayer (getvar "CLAYER"))
  (setvar "CLAYER" newlayer)
  oldlayer
)
;================================================
;; Line type change common
;; Argument : name of linetype to be changed
;; Argument : name of linetype to be changed ;; Return value : name of current linetype
(defun _chng_ltype
  (newltype / oldltype)
  (setq oldltype (getvar "CELTYPE"))
  (setvar "CELTYPE" newltype)
  oldltype
)
;================================================
;;; Line color change common
;; Argument :Line color to be changed
;; Argument: Line color to be changed ;; Return value: Current line color
(defun _chng_lcolor
  (newlcolor / oldlcolor)
  (setq oldlcolor (getvar "CECOLOR"))
  (setvar "CECOLOR" newlcolor)
  oldlcolor
)

[komondormrex]

hi,

what are images A, B, C, D, E, F?

[aspectT2392]

Oh !

Sorry.

[Kent1Cooper · Accepted solution]

You control for object snap at line 69, but not at lines 98 and 99.

[saitoib]

@Kent1Cooper 

Oh.
So that's what you're saying.

I didn't realize it at all.
Thank you very much.

[Kent1Cooper]

You're welcome.  Almost any time something comes out in the wrong place, when (command) functions are involved, Osnap is the first guess for the cause of the problem.  I would point out that your comment at line 70 is incorrect:

;If you don't put "_non", object snap won't work.

It's just the opposite.  If you don't put that in, Osnap will work, and will apply whatever running Osnap modes are set to any specified locations in drawing or editing commands.  You don't want that in this case, and the "_non" applies "NONE" Object Snap to the immediately-following location, overriding whatever modes are set to ignore them.

The alternative is to have the routine turn off Object Snap before it gets to any such commands -- you will find countless examples of that in routines posted in this Forum.