Draw Interfingering lines

Hi guys, Thanks for help!

And you assume that you have 2 cylinders that crosses right centered of each other, or it could be any 3d body that have rectangular elevation like box, prism... The best way to accomplish your task is to make 3D Solids and find union, subtraction or intersection and then use flatshot command on elevation view... Make sure you model both 3D Solids correctly in 3D space (positions) before you use Solid Modeling Operations (subtract, union, intersect)...

Marko Ribar, d.i.a. (arch.)

Marko_ribar like you I would just create solid, how would you add the line pattern to the surface if that is required, I have a couple of ideas tiny circles extruded added to solid objects prior to union-subtract of main parts ? I changed display mesh parameters ?

@marko. vla-boolean?

*EDIT: IMG reloaded

I think we all dont know what the poster means by interfingering lines.

my 2 cents in 3D concept, i hope i do understand inter-fingering

Revision:1.0 @ 22/07/2014

command: TEST

;hanhphuc @cadtutor 15/07/14
;Draw interfingering?
;http://www.cadtutor.net/forum/showthread.php?87594-Draw-Interfingering-lines

;Revision: 1.0	22/07/2014
;flatshot idea suggested by Marko Ribar 	
;debugging....

(defun C:TEST (/ *error*  oldecho p l d e ab solid ro 2D)

 (defun *error* (msg)
   (if	(not (wcmatch (strcase msg) "*CANCEL*,*EXIT*"))
     (princ (strcat "\nError: " msg))
     ) ;_ end of if
   (princ)
   ) ;_ end of defun



 (terpri)
 (setq oldecho (getvar "cmdecho"))
 (setvar "cmdecho" 0)
 (setq	*user* (hp# 'getdist
	    '(6 6 )
	    '("\nDiameter of horizontal cylinder "
	      "\nDiameter of branch cylinder "
	     	)
	    *user*
	    ) ;_ end of hp#

d (* (car *user*) 2.)

ro (getorient "\nBranch angle in degrees : ")

p '(0. 0. 0.)
   
solid
(mapcar	'(lambda (r a b c / ab)
   (apply 'vla-Rotate3D
	  (append (cons	(setq ab (vla-AddCylinder *mspace* (vlax-3d-point a) (/ r 2.) b))
			(mapcar	'(lambda (x) (vlax-3d-point x))
				'((0. 0. 0.) (0. 1. 0.)) ;(car (split *user* 2 t))
				) ;_ end of mapcar
			) ;_ end of cons
		  (list c)
		  ) ;_ end of append
	  ) ;_ end of apply
   ab
   ) ; lambda
*user* ;diameter
(list '(0. 0. 0.) (list (car p) (cadr p) (+ (caddr p) (car *user*))))
(list (* d 2) d)
(list (/ pi 2.)
      (if ro
	(- (* 2.5 pi) ro)
	0.0
	) ;_ end of if
      )
) ; mapcar
   ); setq

(initget "Yes No y n")
(setq 2D (getkword "\nMake solid 3D [Yes/No]? <No> : "))
(if (or(= 2D "No")(not 2D ))
(progn
(command "_vpoint" "0,-1,0");
(vl-cmdf "flatshot" "" (getvar "viewctr") 1 1 0 )

(if solid 
('((x) (vla-boolean (cadr x) 2 (car x)));acSubtraction
solid))


(vl-cmdf "flatshot" "" (getvar "viewctr") 1 1 0 )
(entdel (vlax-vla-object->ename (cadr solid )))
(command "_vpoint" "0,0,0");
)

(progn
('((x) (vla-boolean (car x) 2 (cadr x)))
solid)
(command "vpoint" "1,-1,1")
(command "_VSCURRENT" "Conceptual")
   )
 );if
 
(setvar "cmdecho" oldecho)
 (princ "\nDone..")
 (princ)

) ;_ end of defun

(if (null *user*)
 (setq *user* '(10. 9.0 ) )
 ) ; variable global

(princ "\nhanphuc@cadtutor 2014. Command: TEST")
(princ)
(vl-load-com)
(setq *mspace* (vla-get-modelspace (vla-get-ActiveDocument(vlax-get-acad-object))))


;;;----------------------------------------------------		
;;;								
;; courtesy of the author's of "Inside AutoLisp"		
;; for rel. 10 published by New Riders Publications 		
;; Referenced to the concept of UREAL UKWORD,			
;; which inspired me make this utility #hp			
;; also thanks to ymg the way of handling variable in list	
;; 								

;HP# ; user prompt for numbers by hanhphuc 2014
 (defun hp# (_f _ini _msg _def  / usr l)
 (if (and
(member _f '(getreal getint getdist))
         (vl-every '(lambda (x) (= (type x) 'INT)) _ini )
  )
   (progn (setq usr (mapcar '(lambda ( i a b) (initget i)
		((eval _f) (strcat a " < "(rtos b) " > : ")))
		     _ini
		     _msg
		     _def
		     ) ;_ end of mapcar
	 ) ; setq
   (while usr
     (setq l (cons (if (null (car usr))
			(car _def)
			(car usr)
			) ;_ end of if
		      l
		      ) ;_ end of cons
	   usr	(cdr usr)
	   _def	(cdr _def)
	   ) ;_ end of setq
     l
     ) ;_ end of while
   (reverse l)
   ) ;_ end of progn
   ) ;_ end of if
 ) ;_ end of defun


;sub function: split
;http://www.cadtutor.net/forum/showthread.php?87320-Break-a-list-in-two-sub-lists&highlight=Split+list
(defun split (lst len opt / ls l i) ; opt, T= by division or nil=by length
(setq i 1 l '() len (if opt (/ (length lst) len) len))
 (while lst
   (setq l (append  l (list(car lst))))
   (if
   (zerop (rem i len))
(setq ls (cons l ls) l nil)
   ) 
   (setq i (1+ i) lst (cdr lst))
 ) ;_ end of foreach
 (if l
   (append (reverse ls) (list  l))
   (reverse ls)
 ) ;_ end of if
) ;_ end of defun

my 2 cents in 3D concept, i hope i do understand inter-fingering

command: TEST

;hanhphuc @cadtutor 15/07/14
;Draw interfingering?
;http://www.cadtutor.net/forum/showthread.php?87594-Draw-Interfingering-lines

(defun C:TEST (/ *error* oldvar p l a b c)

 (defun *error* (msg)
   (if	(not (wcmatch (strcase msg) "*CANCEL*,*EXIT*"))
     (princ (strcat "\nError: " msg))
     ) ;_ end of if
   (princ)
   ) ;_ end of defun

 (terpri)
 (setq oldecho (getvar "cmdecho"))
 (setvar "cmdecho" 0)
 (setq	*user* (hp# 'getdist
	    '(6 6 6 2)
	    '("\nRadius horizontal object A: "
	      "\nRadius vertical object B: "
	      "\nLength for horizontal object A: "
	      "\nDepth for vertical object B: "
	      )
	    *user*
	    ) ;_ end of hp#
) ;_ end of setq
 (if (setq p (getpoint "\nPick point.. "))
   (setq l (entmakex (list (cons 0 "LINE")
		    (cons 100 "AcDbLINE")
		    (cons 10 (list (- (car p) (/ (nth 3 *user*) 2)) (cadr p) (caddr p)))
		    (cons 11 (list (+ (car p) (/ (nth 3 *user*) 2)) (cadr p) (caddr p)))
		    ) ;_ end of list
	      ) ;_ end of entmakex
  ) ;_ end of setq
   ) ;_ end of if
 (setq c (mapcar '(lambda (x) (entmakex (list (cons 0 "CIRCLE") (cons 10 p) (cons 40 x))))
	  (car (split *user* 2 t))
	  ) ;_ end of mapcar
) ;_ end of setq
 (princ "\n[Enter] to make solid thru length A.")
 (vl-cmdf "sweep" (car c) "\\" l)
 (setq a (entlast))
 (entdel (car c))
 (princ "\n[Enter] to make solid extrude depth B.")
 (if p
   (vl-cmdf "extrude" (cadr c) "\\" (last *user*))
   ) ;_ end of if
 (setq b (entlast))
 (initget "A a B b")
 (if (= (getkword "Retain object A or B? ") "A")
   (setq ? (list a b))
   (setq ? (list b a))
   ) ;_ end of if

 (if (and a b)
 ('((x) (vla-boolean (car x) acSubtraction (cadr x)))
   (mapcar '(lambda (x) (vlax-ename->vla-object x)) ?)
   )
   )

 (command "vpoint" "1,-1,1")
 (command "_VSCURRENT" "Conceptual")
 (setvar "cmdecho" oldecho)
 (princ)
 ) ;_ end of defun


(if (null *user*)
 (setq *user* '(10. 9.0 30. 30.))
 ) ; global

(princ "\nhanhphuc@cadtutor 2014. Command: TEST")
(princ)

subfunction, user prompt for numbers input with bit control

(HP# f _ini _msg _def) ; argument: f=getxxx , _ini=init_list, _msg=prompt_list, def=default_list

;example: (hp# 'getdist '(6 6 6 2)'(10 10 30 30))

 

;; HP# ; user prompt for numbers  by hanhphuc 2014
;; acknowledgement:					
;; courtesy of the author's of "Inside AutoLisp"		
;; for rel. 10 published by New Riders Publications. 		
;; Referenced to the concept of his UREAL & UKWORD,			
;; which inspired make this utility #hp			
;; also thanks to ymj the way of handling variable in list	
;; 								


 (defun hp# (_f _ini _msg _def  / usr l)
 (if (and(member _f '(getreal getint getdist))
         (vl-every '(lambda (x) (= (type x) 'INT)) _ini )
  )
   (progn (setq usr (mapcar '(lambda (i a b) (initget i) ((eval _f) (strcat a " < "(rtos b) " > : ")))
		     _ini
		     _msg
		     _def
		     ) ;_ end of mapcar
	 ) ; setq
   (while usr
     (setq l (cons (if (null (car usr))
			(car _def)
			(car usr)
			) ;_ end of if
		      l
		      ) ;_ end of cons
	   usr	(cdr usr)
	   _def	(cdr _def)
	   ) ;_ end of setq
     l
     ) ;_ end of while
   (reverse l)
   ) ;_ end of progn
   ) ;_ end of if
 ) ;_ end of defun

;sub function: split
;http://www.cadtutor.net/forum/showthread.php?87320-Break-a-list-in-two-sub-lists&highlight=Split+list
(defun split (lst len opt / ls l i) ; opt, T= by division or nil=by length
(setq i 1 l '() len (if opt (/ (length lst) len) len))
 (while lst
   (setq l (append  l (list(car lst))))
   (if
   (zerop (rem i len))
(setq ls (cons l ls) l nil)
   ) 
   (setq i (1+ i) lst (cdr lst))
 ) ;_ end of foreach
 (if l
   (append (reverse ls) (list  l))
   (reverse ls)
 ) ;_ end of if
) ;_ end of defun

Thanks very much !hanhphuc ,

But I can't understand, Can you upload a demo file（Gif file）

Making GIF demo software: http://www.cockos.com/licecap/

Here is something from the old days.

(defun c:tj (/ d1 d2 ud2 uu1 apdeg apr ap r1 r2 a b c d e f e1 cp1)

 (command "_.undo" "_begin")
 (setq osn (getvar "osmode"))
 (setvar "cmdecho" 0)

 (setq oerr *error*)
 (defun *error* (msg)
   (setvar "osmode" osn)
   (princ "\n Function cancelled - Try again ")
   (setq *error* oerr)
   (command)
   (princ)
 )


 (princ "\n Straight pipe diameter < ")
 (if dd1
   (princ dd1)				; prints default value
 )
 (princ " > ?? :")
 (setq d1 (getdist))
 (if (= d1 nil)
   (setq d1 dd1)
 )
 (setq dd1 d1)

 (princ "\n Branch pipe diameter < ")
 (if dd2
   (princ dd2)
 )					; prints default value
 (princ " > ?? :")
 (setq d2 (getdist))
 (if (= d2 nil)
   (setq d2 dd2)
 )
 (setq dd2 d2)
 (if (> d2 d1)
   (progn
     (alert
" Branch pipe diameter must be equal or smaller than straight pipe\nSTART OVER"
     )
     (^c^c)
   )
 )
 (if ud1
   (setq ud2 (* (/ ud1 pi) 180))
 )
 (princ "\n Branch pipe entry angle < ")
 (if ud1
   (princ ud2)				; prints default value
 )
 (princ " > ?? : ")
 (setq uu1 (getangle))
 (if (= uu1 nil)
   (setq uu1 ud1)
 )
 (if (>= uu1 pi)
   (progn
     (alert "Angle must be smaller than 180 deg\nStart over")
     (c^c^)
   )
 )
 (if (= uu1 0)
   (c^c^)
 )
 (setq ud1 uu1)
 (setq u1 (* (/ uu1 pi) 180))

 (setq apdeg 10.0)			;angle of precision
 (setq ap (/ (* apdeg pi) 180))
 (setq apr ap)

 (setq ip (getpoint "\n Curve insertion (left endpoint): "))


 (setq r1 (/ d1 2))
 (setq r2 (/ d2 2))
 (setvar "osmode" 0)

 (setq a (- r2 (* r2 (cos ap))))
 (setq b (/ a (sin uu1)))
 (setq c (* r2 (sin ap)))
 (setq d (- r1 (sqrt (- (expt r1 2) (expt c 2)))))
 (setq f (- b (/ d (tan uu1))))
 (setq cp1 (polar ip 0 f))
 (setq p1 (polar cp1 (* pi 1.5) d))
 (command "pline" ip "w" 0 0 p1 "")
 (setq e (entlast))
 (setq ap (+ ap apr))

 (while (< ap pi)
   (setq a (- r2 (* r2 (cos ap))))
   (setq b (/ a (sin uu1)))
   (setq c (* r2 (sin ap)))
   (setq d (- r1 (sqrt (- (expt r1 2) (expt c 2)))))
   (setq f (- b (/ d (tan uu1))))
   (setq cp1 (polar ip 0 f))
   (setq p1 (polar cp1 (* pi 1.5) d))
   (command "line" "" p1 "")
   (setq e1 (entlast))
   (command "pedit" e "j" e1 "" c^c^)
   (setq ap (+ ap apr))
 )
 (command "pedit" e "f" "" c^c^)
 (setvar "osmode" osn)
 (command "rotate" e "" ip pause)
 (command "_.undo" "_end")
 (princ "\n\n\n\n Straight pipe dia = ")
 (princ d1)
 (princ "\n Branch pipe dia   = ")
 (princ d2)
 (princ "\n Branch pipe angle = ")
 (princ u1)
 (princ)
)

Here is something from the old days.

 

(defun c:tj (/ d1 d2 ud2 uu1 apdeg apr ap r1 r2 a b c d e f e1 cp1)

 (command "_.undo" "_begin")
 (setq osn (getvar "osmode"))
 (setvar "cmdecho" 0)

 (setq oerr *error*)
 (defun *error* (msg)
   (setvar "osmode" osn)
   (princ "\n Function cancelled - Try again ")
   (setq *error* oerr)
   (command)
   (princ)
 )


 (princ "\n Straight pipe diameter < ")
 (if dd1
   (princ dd1)				; prints default value
 )
 (princ " > ?? :")
 (setq d1 (getdist))
 (if (= d1 nil)
   (setq d1 dd1)
 )
 (setq dd1 d1)

 (princ "\n Branch pipe diameter < ")
 (if dd2
   (princ dd2)
 )					; prints default value
 (princ " > ?? :")
 (setq d2 (getdist))
 (if (= d2 nil)
   (setq d2 dd2)
 )
 (setq dd2 d2)
 (if (> d2 d1)
   (progn
     (alert
" Branch pipe diameter must be equal or smaller than straight pipe\nSTART OVER"
     )
     (^c^c)
   )
 )
 (if ud1
   (setq ud2 (* (/ ud1 pi) 180))
 )
 (princ "\n Branch pipe entry angle < ")
 (if ud1
   (princ ud2)				; prints default value
 )
 (princ " > ?? : ")
 (setq uu1 (getangle))
 (if (= uu1 nil)
   (setq uu1 ud1)
 )
 (if (>= uu1 pi)
   (progn
     (alert "Angle must be smaller than 180 deg\nStart over")
     (c^c^)
   )
 )
 (if (= uu1 0)
   (c^c^)
 )
 (setq ud1 uu1)
 (setq u1 (* (/ uu1 pi) 180))

 (setq apdeg 10.0)			;angle of precision
 (setq ap (/ (* apdeg pi) 180))
 (setq apr ap)

 (setq ip (getpoint "\n Curve insertion (left endpoint): "))


 (setq r1 (/ d1 2))
 (setq r2 (/ d2 2))
 (setvar "osmode" 0)

 (setq a (- r2 (* r2 (cos ap))))
 (setq b (/ a (sin uu1)))
 (setq c (* r2 (sin ap)))
 (setq d (- r1 (sqrt (- (expt r1 2) (expt c 2)))))
 (setq f (- b (/ d (tan uu1))))
 (setq cp1 (polar ip 0 f))
 (setq p1 (polar cp1 (* pi 1.5) d))
 (command "pline" ip "w" 0 0 p1 "")
 (setq e (entlast))
 (setq ap (+ ap apr))

 (while (< ap pi)
   (setq a (- r2 (* r2 (cos ap))))
   (setq b (/ a (sin uu1)))
   (setq c (* r2 (sin ap)))
   (setq d (- r1 (sqrt (- (expt r1 2) (expt c 2)))))
   (setq f (- b (/ d (tan uu1))))
   (setq cp1 (polar ip 0 f))
   (setq p1 (polar cp1 (* pi 1.5) d))
   (command "line" "" p1 "")
   (setq e1 (entlast))
   (command "pedit" e "j" e1 "" c^c^)
   (setq ap (+ ap apr))
 )
 (command "pedit" e "f" "" c^c^)
 (setvar "osmode" osn)
 (command "rotate" e "" ip pause)
 (command "_.undo" "_end")
 (princ "\n\n\n\n Straight pipe dia = ")
 (princ d1)
 (princ "\n Branch pipe dia   = ")
 (princ d2)
 (princ "\n Branch pipe angle = ")
 (princ u1)
 (princ)
)

Thanks very much, paulmcz

But I can't understand, Can you upload a demo file（Gif file）

Making GIF demo software: http://www.cockos.com/licecap/

Thanks very much !hanhphuc ,

But I can't understand, Can you upload a demo file（Gif file）

 

Making GIF demo software: http://www.cockos.com/licecap/

Good morning You are welcome

But it seem you are not familiar with LISP?

You try to read this link given, courtesy of

http://www.lee-mac.com/runlisp.html

I'll assist when I'm free, cheers

Good morning You are welcome

But it seem you are not familiar with LISP?

You try to read this link given, courtesy of

http://www.lee-mac.com/runlisp.html

I'll assist when I'm free, cheers

I Know how to use lisp, But I don't know your routine, use for 3d or 2d ?

Hi liu, Thanx for sharing the gif maker.

Well, actually I've set all the default parameter, it should be easy..

Command : TEST

1.prompt input radius etc.., just press [ENTER]x4times if you not sure,

2.then pick any point on the screen to draw object

3.prompt make 3D extrude solid, just press [enter] twice (2 objects merged)

4.prompt option A or B , just key-in A or B then [enter] again that's all

Here you have the gif file showing how it works

Thanks very much, paulmcz

 

But I can't understand, Can you upload a demo file（Gif file）

 

Making GIF demo software: http://www.cockos.com/licecap/

Here you have the gif file showing how it works

Thanks paulmcz, I can't open this link! can you email to me ? [liuhaixin88@sina.com]

Gif file emailed. Did you get it?

I tried to upload it here but it uploaded just an initial frame from the gif and in form of JPEG. So I removed the file. Anybody knows how to upload a fully functional "gif" file to this site?

Gif file emailed. Did you get it?

 

I tried to upload it here but it uploaded just an initial frame from the gif and in form of JPEG. So I removed the file. Anybody knows how to upload a fully functional "gif" file to this site?

Thank you ,Paul , I get it ,

I Try your routine, but failed.

Makine GIF ,you can try "Gifcam" , and if you apload Gif file ,when the upload to complete, but it change to JPEG file ,that may be the gif file is too large.

I am sorry, I didn't include the "tan" function. Here it is again. I hope, it will work for you this time.

(defun c:tj (/ d1 d2 ud2 uu1 apdeg apr ap r1 r2 a b c d e f e1 cp1)

 (command "_.undo" "_begin")
 (setq osn (getvar "osmode"))
 (setvar "cmdecho" 0)

 (setq oerr *error*)
 (defun *error* (msg)
   (setvar "osmode" osn)
   (princ "\n Function cancelled - Try again ")
   (setq *error* oerr)
   (command)
   (princ)
 )


 (princ "\n Straight pipe diameter < ")
 (if dd1
   (princ dd1)				; prints default value
 )
 (princ " > ?? :")
 (setq d1 (getdist))
 (if (= d1 nil)
   (setq d1 dd1)
 )
 (setq dd1 d1)

 (princ "\n Branch pipe diameter < ")
 (if dd2
   (princ dd2)
 )					; prints default value
 (princ " > ?? :")
 (setq d2 (getdist))
 (if (= d2 nil)
   (setq d2 dd2)
 )
 (setq dd2 d2)
 (if (> d2 d1)
   (progn
     (alert
" Branch pipe diameter must be equal or smaller than straight pipe\nSTART OVER"
     )
     (^c^c)
   )
 )
 (if ud1
   (setq ud2 (* (/ ud1 pi) 180))
 )
 (princ "\n Branch pipe entry angle < ")
 (if ud1
   (princ ud2)				; prints default value
 )
 (princ " > ?? : ")
 (setq uu1 (getangle))
 (if (= uu1 nil)
   (setq uu1 ud1)
 )
 (if (>= uu1 pi)
   (progn
     (alert "Angle must be smaller than 180 deg\nStart over")
     (c^c^)
   )
 )
 (if (= uu1 0)
   (c^c^)
 )
 (setq ud1 uu1)
 (setq u1 (* (/ uu1 pi) 180))

 (setq apdeg 10.0)			;angle of precision
 (setq ap (/ (* apdeg pi) 180))
 (setq apr ap)

 (setq ip (getpoint "\n Curve insertion (left endpoint): "))


 (setq r1 (/ d1 2))
 (setq r2 (/ d2 2))
 (setvar "osmode" 0)

 (setq a (- r2 (* r2 (cos ap))))
 (setq b (/ a (sin uu1)))
 (setq c (* r2 (sin ap)))
 (setq d (- r1 (sqrt (- (expt r1 2) (expt c 2)))))
 (setq f (- b (/ d (tan uu1))))
 (setq cp1 (polar ip 0 f))
 (setq p1 (polar cp1 (* pi 1.5) d))
 (command "pline" ip "w" 0 0 p1 "")
 (setq e (entlast))
 (setq ap (+ ap apr))

 (while (< ap pi)
   (setq a (- r2 (* r2 (cos ap))))
   (setq b (/ a (sin uu1)))
   (setq c (* r2 (sin ap)))
   (setq d (- r1 (sqrt (- (expt r1 2) (expt c 2)))))
   (setq f (- b (/ d (tan uu1))))
   (setq cp1 (polar ip 0 f))
   (setq p1 (polar cp1 (* pi 1.5) d))
   (command "line" "" p1 "")
   (setq e1 (entlast))
   (command "pedit" e "j" e1 "" c^c^)
   (setq ap (+ ap apr))
 )
 (command "pedit" e "f" "" c^c^)
 (setvar "osmode" osn)
 (command "rotate" e "" ip pause)
 (command "_.undo" "_end")
 (princ "\n\n\n\n Straight pipe dia = ")
 (princ d1)
 (princ "\n Branch pipe dia   = ")
 (princ d2)
 (princ "\n Branch pipe angle = ")
 (princ u1)
 (princ)
)

(defun tan (xx)	
 (/ (sin xx) (cos xx))
)

Hi liu, Thanx for sharing the gif maker.

Well, actually I've set all the default parameter, it should be easy..

Command : TEST

1.prompt input radius etc.., just press [ENTER]x4times if you not sure,

2.then pick any point on the screen to draw object

3.prompt make 3D extrude solid, just press [enter] twice (2 objects merged)

4.prompt option A or B , just key-in A or B then [enter] again that's all

Thanks hanhphuc,

I know your routine is create a 3d solid. That's not what I want, I need draw Interfingering lines in 2d mode.

Like this :

I am sorry, I didn't include the "tan" function. Here it is again. I hope, it will work for you this time.

 

Thank you !Paul, now is ok ! nice ! I need some time to verify.

Thanks hanhphuc,

I know your routine is create a 3d solid. That's not what I want, I need draw Interfingering lines in 2d mode.

i'm sorry liuhaixin. 3D interfingering can't help, luckily paulmcz for helping thanx

code revised as per Marko's suggestion flatshot is a good idea for irregular shape merged.