home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p024 / 6.img / SUPPORT4.LIB / DLINE.LSP < prev    next >
Encoding:
Text File  |  1993-02-09  |  65.3 KB  |  2,132 lines

  1. ;;;   DLINE.LSP
  2. ;;;   ¬⌐Ñ╗ (C) 1990-1992  Autodesk ñ╜Ñq
  3. ;;;
  4. ;;;   Ñ╗│n┼ΘºK╢O¿╤▒z╢iªµÑ⌠ª≤Ñ╬│~╗▌¿D¬║½■¿⌐íB¡╫º∩ñ╬╡oªµ, ª²¼O░╚╜╨┐φ┤`ñU¡z
  5. ;;;   ¡∞½h :
  6. ;;;
  7. ;;;   1)  ñWªC¬║¬⌐┼v│qºi░╚╗▌ÑX▓{ªb¿Cñ@Ñ≈½■¿⌐∙╪íC
  8. ;;;   2)  ¼█├÷¬║╗í⌐·ñσÑ≤ñ]Ñ▓╢╖⌐·╕ⁿ¬⌐┼v│qºiñ╬Ñ╗╢╡│\Ñi│qºiíC
  9. ;;;
  10. ;;;   Ñ╗│n┼Θ╢╚┤ú¿╤º@¼░└│Ñ╬ñW¬║░╤ª╥, ª╙Ñ╝┴n⌐·⌐╬┴⌠ºtÑ⌠ª≤½O├╥; ╣∩⌐≤Ñ⌠ª≤»S«φ
  11. ;;;   Ñ╬│~ñº╛A║┘⌐╩, ÑHñ╬░╙╖~╛P░Γ⌐╥┴⌠ºtÑX¿π¬║½O├╥, ªbª╣ñ@╖ºñ⌐ÑHº_╗{íC
  12. ;;;
  13. ;;;
  14. ;;;   DESCRIPTION
  15. ;;;
  16. ;;;     This is a general purpose "double-line/arc" generator.  It performs
  17. ;;;     automatic corner intersection cleanups, as well as a number of other
  18. ;;;     features described below.
  19. ;;;
  20. ;;;     The user is prompted for a series of endpoints.  As they are picked
  21. ;;;     "DLINE"  segments are drawn on the current layer.  Options are
  22. ;;;     available for changing the Width of the DLINE, specifying whether
  23. ;;;     or not to Snap to existing lines or arcs, whether or not to
  24. ;;;     Break the lines or arcs when snapping to them, and which of the
  25. ;;;     following to do:
  26. ;;;
  27. ;;;     Set the global variable dl:ecp to the values listed below:
  28. ;;;
  29. ;;;     Value  Meaning
  30. ;;;     ---------------------------
  31. ;;;       0    No end caps
  32. ;;;       1    Start end cap only
  33. ;;;       2    Ending end cap only
  34. ;;;       3    Both end caps
  35. ;;;       4    Auto ON -- Cap any end not on a line or arc.
  36. ;;;
  37. ;;;     The user may choose to back up as far as the beginning of the command
  38. ;;;     by typing "U" or "Undo", both of which operate as AutoCAD's "UNDO 1"
  39. ;;;     does.
  40. ;;;
  41. ;;;     Curved DLINE's are drawn using the AutoCAD ARC command and follow as
  42. ;;;     closely as possible its command structure for the various options.
  43. ;;;
  44. ;;;----------------------------------------------------------------------------
  45. ;;;   OPERATION
  46. ;;;
  47. ;;;     The routine is executed, after loading, by typing either DL or DLINE
  48. ;;;     at which time you are presented with the opening line and menu of
  49. ;;;     choices:
  50. ;;;
  51. ;;;       Dline, Version 1.11, (c) 1990-1992 by Autodesk, Inc.
  52. ;;;       Break/Caps/Dragline/Offset/Snap/Undo/Width/<start point>:
  53. ;;;
  54. ;;;     Typing Break allows you to set breaking of lines and arcs found at
  55. ;;;     the start and end points of any segment either ON or OFF.
  56. ;;;
  57. ;;;       Break Dline's at start and end points?  OFF/<ON>:
  58. ;;;
  59. ;;;     Typing Caps allows you to specify how the DLINE will be finished
  60. ;;;     off when exiting the routine, per the values listed above.
  61. ;;;
  62. ;;;       Draw which endcaps?  Both/End/None/Start/<Auto>:
  63. ;;;
  64. ;;;     The default of Auto caps an end only if you did not snap to an arc
  65. ;;;     or line.
  66. ;;;
  67. ;;;     Typing Dragline allows you to set the location of the dragline
  68. ;;;     relative to the centerline of the two arcs or lines to any value
  69. ;;;     between - 1/2 of "tracewid" and + 1/2 of "tracewid".  (There is a
  70. ;;;     local variable you may set if you want to experiment with offsets
  71. ;;;     outside this range;  the results may not be correct, your choice.
  72. ;;;     See the function (dl_sao) for more information.)
  73. ;;;
  74. ;;;       Set dragline position to Left/Center/Right/<Offset from center = 0.0>:
  75. ;;;
  76. ;;;     Enter any real number or one of the keywords.  The value in the angle
  77. ;;;     brackets is the default value and changes as you change the dragline
  78. ;;;     position.
  79. ;;;
  80. ;;;     Offset allows the first point you enter to be offset from a known
  81. ;;;     point.
  82. ;;;
  83. ;;;       Offset from:  (enter a point)
  84. ;;;       Offset toward:    (enter a point)
  85. ;;;       Enter the offset distance:   (enter a distance or real number)
  86. ;;;
  87. ;;;     Snap allows you to set the snapping size and turn snapping ON or OFF.
  88. ;;;
  89. ;;;       Set snap size or snap On/Off.  Size/OFF/<ON>:
  90. ;;;       New snap size (1 - 10):
  91. ;;;
  92. ;;;     The upper limit may be reset by changing the value of MAXSNP to a
  93. ;;;     value other than 10.  Higher values may be necessary for ADI display
  94. ;;;     drivers, but generally, you should keep this value somewhere in the
  95. ;;;     middle of the allowed range for snapping to work most effectively
  96. ;;;     in an uncluttered drawing, and toward the lower end for a more
  97. ;;;     cluttered drawing.  You may also use object snap to improve your
  98. ;;;     aim.
  99. ;;;
  100. ;;;     This feature allows you to very quickly "snap" to another line or arc,
  101. ;;;     breaking it at the juncture and performing all of the intersection
  102. ;;;     cleanups at one time without having to be precisely on the line, i.e.,
  103. ;;;     you can be visually one the line and it will work, or you can use
  104. ;;;     object snap to be more precise.
  105. ;;;
  106. ;;;     Undo backs you up one segment in the chain of segments you are drawing,
  107. ;;;     stopping when there are no more segments to be undone.  All of the
  108. ;;;     necessary points are saved in lists so that the DLINE will close, cap,
  109. ;;;     and continue correctly after any number of undo's.
  110. ;;;
  111. ;;;     Width prompts you for a new width.
  112. ;;;
  113. ;;;       New DLINE width <1.0000>:
  114. ;;;
  115. ;;;     You may enter a new width and continue the DLINE in the same direction
  116. ;;;     you were drawing before;  if you do this, connecting lines from the
  117. ;;;     endpoints of the previous segment are drawn to the start points of
  118. ;;;     the new segment.
  119. ;;;
  120. ;;;     If you press RETURN after closing a DLINE or before creating any
  121. ;;;     DLINE's, you will see this message:
  122. ;;;
  123. ;;;       No continuation point -- please pick a point.
  124. ;;;       Break/Caps/Dragline/Offset/Snap/Undo/Width/<start point>:
  125. ;;;
  126. ;;;     After you pick the first point, you will see this set of options:
  127. ;;;
  128. ;;;       Arc/Break/CAps/CLose/Dragline/Snap/Undo/Width/<next point>:
  129. ;;;
  130. ;;;     Picking more points will draw straight DLINE segments until either
  131. ;;;     RETURN is pressed or the CLose option is chosen.
  132. ;;;
  133. ;;;     CLose will close the lines if you have drawn at least two segments.
  134. ;;;
  135. ;;;     Selecting Arc presents you with another set of choices:
  136. ;;;
  137. ;;;       Break/CAps/CEnter/CLose/Dragline/Endpoint/Line/Snap/Undo/Width/<second point>:
  138. ;;;
  139. ;;;     All of the options here are the same as they are for drawing straight
  140. ;;;     DLINE's except CEnter, Endpoint, and Line.
  141. ;;;
  142. ;;;     The default option, CEnter, and Endpoint are modeled after the ARC
  143. ;;;     command in AutoCAD and exactly mimic its operation including all of
  144. ;;;     the subprompts.  Refer to the AutoCAD reference manual for exact usage.
  145. ;;;
  146. ;;;     The Line option returns you to drawing straight DLINE segments.
  147. ;;;
  148. ;;;     Snapping to existing LINE's an ARC's accomplishes all of the trimming
  149. ;;;     and extending of lines and arcs necessary, including cases where arcs
  150. ;;;     and lines do not intersect.  In these cases a line is drawn from either;
  151. ;;;     a point on the arc at the perpendicular point from the center of the
  152. ;;;     arc to the line, to the line, or along the line from the centers of the
  153. ;;;     two arcs that do not intersect at the points where this line crosses
  154. ;;;     the two arcs.  In this way, we ensure that all DLINE's can be closed
  155. ;;;     visually.
  156. ;;;
  157. ;;;     Breaking will not work unless Snapping is turned on.
  158. ;;;
  159. ;;;----------------------------------------------------------------------------
  160. ;;;  GLOBALS:
  161. ;;;     dl:osd -- dragline alignment offset from center of two lines or arcs.
  162. ;;;     dl:snp -- T if snapping to existing lines and arcs.
  163. ;;;     dl:brk -- T if breaking existing lines and arcs.
  164. ;;;     dl:ecp -- Bitwise setting of caps when exiting.
  165. ;;;     v:stpt -- Continuation point.
  166. ;;;----------------------------------------------------------------------------
  167. ;;;
  168. ;;; ===========================================================================
  169. ;;; ===================== load-time error checking ============================
  170. ;;;
  171.  
  172.   (defun ai_abort (app msg)
  173.      (defun *error* (s)
  174.         (if old_error (setq *error* old_error))
  175.         (princ)
  176.      )
  177.      (if msg
  178.        (alert (strcat " └│Ñ╬╡{ªí┐∙╗~: "
  179.                       app
  180.                       " \n\n  "
  181.                       msg
  182.                       "  \n"
  183.               )
  184.        )
  185.      )
  186.      (exit)
  187.   )
  188.  
  189. ;;; Check to see if AI_UTILS is loaded, If not, try to find it,
  190. ;;; and then try to load it.
  191. ;;;
  192. ;;; If it can't be found or it can't be loaded, then abort the
  193. ;;; loading of this file immediately, preserving the (autoload)
  194. ;;; stub function.
  195.  
  196.   (cond
  197.      (  (and ai_dcl (listp ai_dcl)))          ; it's already loaded.
  198.  
  199.      (  (not (findfile "ai_utils.lsp"))                     ; find it
  200.         (ai_abort "DLINE"
  201.                   (strcat "ºΣñú¿∞íuAI_UTILS.LSPív└╔«╫;"
  202.                           "\n └╦¼díusupportívÑ╪┐²íC")))
  203.  
  204.      (  (eq "failed" (load "ai_utils" "failed"))            ; load it
  205.         (ai_abort "DLINE" "╡L¬k╕ⁿñJíuAI_UTILS.LSPív└╔«╫"))
  206.   )
  207.  
  208.   (if (not (ai_acadapp))               ; defined in AI_UTILS.LSP
  209.       (ai_abort "DLINE" nil)         ; a Nil <msg> supresses
  210.   )                                    ; ai_abort's alert box dialog.
  211.  
  212. ;;; ==================== end load-time operations ===========================
  213. ;;; Main function
  214.  
  215. (defun dline  (/ strtpt nextpt pt1    pt2    spts   wnames elast
  216.                  uctr   pr     prnum  temp   ans    dir    ipt
  217.                  v      lst    dist   cpt    rad    orad   ftmp
  218.                  spt    ept    pt     en1    en2    npt    cpt1
  219.                  flg    cont   flg2   flgn   ang    tmp    undo_setting
  220.                  brk_e1 brk_e2 bent1  bent2  nn     nnn
  221.                  dl_osm dl_oem dl_oce dl_opb dl_obm dl_ver
  222.                  dl_err dl_oer dl_arc fang   MAXSNP ange
  223.                  savpt1 savpt2 savpt3 savpt4 savpts
  224.               )
  225.  
  226.   ;; Version number.  Reset this local if you make a change.
  227.   (setq dl_ver "1.11")
  228.  
  229.   ;; Reset this value higher for ADI drivers.
  230.   (setq MAXSNP 10)
  231.  
  232.   (setq dl_osm (getvar "osmode")
  233.         dl_oce (getvar "cmdecho")
  234.         dl_opb (getvar "pickbox")
  235.   )
  236.  
  237.   ;;
  238.   ;; Internal error handler defined locally
  239.   ;;
  240.  
  241.   (defun dl_err (s)                   ; If an error (such as CTRL-C) occurs
  242.                                       ; while this command is active...
  243.     (if (/= s "Function cancelled")
  244.       (if (= s "quit / exit abort")
  245.         (princ)
  246.         (princ (strcat "\n┐∙╗~: " s))
  247.       )
  248.     )
  249.     (command "_.UNDO" "_EN")
  250.     (ai_undo_off)
  251.     (if dl_oer                        ; If an old error routine exists
  252.       (setq *error* dl_oer)           ; then, reset it
  253.     )
  254.     (if dl_osm (setvar "osmode" dl_osm))
  255.     (if dl_opb (setvar "pickbox" dl_opb))
  256.  
  257.     ;; Reset command echoing on error
  258.     (if dl_oce (setvar "cmdecho" dl_oce))
  259.     (princ)
  260.   )
  261.  
  262.   ;; Set our new error handler
  263.   (if (not *DEBUG*)
  264.     (if *error*
  265.       (setq dl_oer *error* *error* dl_err)
  266.       (setq *error* dl_err)
  267.     )
  268.   )
  269.  
  270.   (setvar "cmdecho" 0)
  271.   (ai_undo_on)                       ; Turn on UNDO
  272.   (command "_.UNDO" "_GROUP")
  273.   (setvar "osmode" 0)
  274.   (if (null dl:opb) (setq dl:opb (getvar "pickbox")))
  275.  
  276.  
  277.   (setq nextpt "Straight")
  278.  
  279.   ;; Get the first segment's start point
  280.  
  281.   (menucmd "s=dline1")
  282.   (graphscr)
  283.   (princ (strcat "\nDline, ¬⌐Ñ╗ " dl_ver ", (c) 1990-1992  Autodesk ñ╜ÑqíC"))
  284.  
  285.   (setq cont T)
  286.   (while cont
  287.     (dl_m1)
  288.  
  289.     ;; Ready to draw successive DLINE segments
  290.  
  291.     (dl_m2)
  292.   )
  293.  
  294.   (if dl_osm (setvar "osmode" dl_osm))
  295.   (if dl_opb (setvar "pickbox" dl_opb))
  296.  
  297.   (ai_undo_off)                      ; Return UNDO to initial state
  298.  
  299.   ;; Reset command echoing
  300.   (if dl_oce (setvar "cmdecho" dl_oce))
  301.   (menucmd "s=s")
  302.   (princ)
  303. )
  304. ;;;
  305. ;;; Main function subsection 1.
  306. ;;;
  307. ;;; dl_m1 == DLine_Main_1
  308. ;;;
  309. (defun dl_m1 ()
  310.   (setq temp T
  311.         uctr nil
  312.   )
  313.   (if dl_arc
  314.     (setq nextpt "Arc")
  315.     (setq nextpt "Line")
  316.   )
  317.   ;; temp set to nil when a valid point is entered.
  318.   (while temp
  319.     (initget "Break Caps Dragline Offset Snap Undo Width")
  320.     (setq strtpt (getpoint
  321.       "\nB║I┬_/C½╩║▌/D⌐∞ñ▐╜u/O░╛▓╛/S┬Ω┬I/U░hª^/W╝e½╫/<░_⌐l┬I>: "))
  322.     (cond
  323.       ((= strtpt "Dragline")
  324.         (dl_sao)
  325.       )
  326.       ((= strtpt "Break")
  327.         (initget "ON OFf")
  328.         (setq dl:brk (getkword
  329.           "\níu░_⌐l┬Iív╗Píu▓╫ñε┬Iív│B╣Jª│┬∙╜u▒Nñ⌐íu║I┬_ív? OFf/<ON>: "))
  330.         (setq dl:brk (if (= dl:brk "OFf") nil T))
  331.       )
  332.       ((= strtpt "Offset")
  333.         (dl_ofs)
  334.       )
  335.       ((= strtpt "Snap")
  336.         (dl_sso)
  337.       )
  338.       ((= strtpt "Undo")
  339.         (princ "\nñw░hª^⌐╥ª│¬║╜u¼qíC")
  340.         (setq temp T)
  341.       )
  342.       ((= strtpt "Width")
  343.         (initget 6)
  344.         (dl_snw)
  345.         (setq temp T)
  346.       )
  347.       ((null strtpt)
  348.         (if v:stpt
  349.           (setq strtpt v:stpt
  350.                 temp   nil
  351.           )
  352.           (progn
  353.             (princ "\nºΣñú¿∞íu⌐╡─≥┬Iív í╨ ╜╨¼D┐∩ñ@┬IíC")
  354.           )
  355.         )
  356.       )
  357.       ((= strtpt "Caps")
  358.         (endcap)
  359.       )
  360.       ;; If none of the above, it must be OK to continue - a point has been
  361.       ;; picked or entered from the keyboard.
  362.       (T
  363.         (setq v:stpt strtpt
  364.               temp   nil
  365.         )
  366.       )
  367.     )
  368.   )
  369. )
  370. ;;;
  371. ;;; Main function subsection 2.
  372. ;;;
  373. ;;; dl_m3 == DLine_Main_2
  374. ;;;
  375. (defun dl_m2 (/ temp)
  376.   (setq spts (list strtpt)
  377.         uctr 0
  378.   )
  379.   (if dl:snp
  380.     (dl_ved "brk_e1" strtpt)
  381.   )
  382.   ;; Make sure that the offset is not greater than 1/2 of "tracewid", even
  383.   ;; if the user transparently resets it while the command is running.
  384.   (setq temp (/ (getvar "tracewid") 2.0))
  385.   (if (< dl:osd (- temp))
  386.     (setq dl:osd (- temp))
  387.   )
  388.   (if (> dl:osd temp)
  389.     (setq dl:osd temp)
  390.   )
  391.  
  392.   (while (and nextpt (/= nextpt "CLose"))
  393.     (if (/= nextpt "Quit")
  394.       (if dl_arc
  395.         (progn
  396.           (menucmd "s=dline2")
  397.           (initget
  398.             "Break CAps CEnter CLose Dragline Endpoint Line Snap Undo Width")
  399.           (setq nextpt (getpoint strtpt (strcat
  400.             "\nB║I┬_/CA½╩║▌/CEñññ▀/CL│¼ªX/D⌐∞ñ▐╜u/E║▌┬I/"
  401.             "L╜u/S┬Ω┬I/U░hª^/W╝e½╫/<▓─ñG┬I>: "))
  402.           )
  403.         )
  404.         (progn
  405.           (menucmd "s=dline3")
  406.           (initget "Arc Break CAps CLose Dragline Snap Undo Width")
  407.           (setq nextpt (getpoint strtpt
  408.             "\nA⌐╖/B║I┬_/CA½╩║▌/CL│¼ªX/D⌐∞ñ▐╜u/S┬Ω┬I/U░hª^/W╝e½╫/<ñUñ@┬I>: ")
  409.           )
  410.         )
  411.       )
  412.     )
  413.     (setq v:stpt (last spts))
  414.     (cond
  415.       ((= nextpt "Dragline")
  416.         (dl_sao)
  417.       )
  418.       ((= nextpt "Width")
  419.         (dl_snw)
  420.  
  421.       )
  422.       ((= nextpt "Undo")
  423.         (cond
  424.           ;;((= uctr 0) (princ "\nñw¿Sª│ñ░╗≥Ñiíu░hª^ívñFíC") )
  425.           ((= uctr 0) (setq nextpt nil) )
  426.           ((> uctr 0)
  427.             (command "_.U")
  428.             (setq spts   (dl_lsu spts 1))
  429.             (setq savpts (dl_lsu savpts 2))
  430.             (setq wnames (dl_lsu wnames 2))
  431.             (setq uctr (- uctr 2))
  432.             (setq strtpt (last spts))
  433.           )
  434.         )
  435.         (if dl:snp
  436.           (if (= uctr 0)
  437.             (dl_ved "brk_e1" strtpt)
  438.           )
  439.         )
  440.       )
  441.       ((= nextpt "Break")
  442.         (initget "ON OFf")
  443.         (setq dl:brk (getkword
  444.           "\níu░_⌐l┬Iív╗Píu▓╫ñε┬Iív│B╣Jª│┬∙╜u▒Nñ⌐íu║I┬_ív? OFf/<ON>: "))
  445.         (setq dl:brk (if (= dl:brk "OFf") nil T))
  446.  
  447.         (if dl:snp
  448.           (dl_ved "brk_e1" strtpt)
  449.         )
  450.         (if dl_arc
  451.           (setq nextpt "Arc")
  452.           (setq nextpt "Line")
  453.         )
  454.       )
  455.       ((= nextpt "Snap")
  456.         (dl_sso)
  457.       )
  458.       ((= nextpt "Arc")
  459.         (setq dl_arc T)               ; Change to Arc segment prompt.
  460.       )
  461.       ((= nextpt "Line")
  462.         (setq dl_arc nil)             ; Change to Line segment prompt.
  463.       )
  464.       ((= nextpt "CLose")
  465.         (dl_cls)
  466.       )
  467.       ((= (type nextpt) 'LIST)
  468.         (dl_ds)
  469.       )
  470.       ((= nextpt "CEnter")
  471.         (dl_ceo)
  472.       )
  473.       ((= nextpt "Endpoint")
  474.         (dl_epo)
  475.       )
  476.       ((= nextpt "CAps")
  477.         (endcap)                      ; Set which caps to draw when exiting.
  478.       )
  479.       (T
  480.         (setq nextpt nil cont nil)
  481.         (if (> uctr 1)
  482.           (if (= (logand 4 dl:ecp) 4)
  483.             (progn
  484.               (if (null brk_e1) (command "_.LINE" savpt1 savpt2 ""))
  485.               (dl_ssp)
  486.               (if (null brk_e2) (command "_.LINE" savpt3 savpt4 ""))
  487.             )
  488.             (progn
  489.               (if (= (logand 1 dl:ecp) 1)
  490.                 (command "_.LINE" savpt1 savpt2 "")
  491.               )
  492.               (if (= (logand 2 dl:ecp) 2)
  493.                 (progn
  494.                   (dl_ssp)
  495.                   (command "_.LINE" savpt3 savpt4 "")
  496.                 )
  497.               )
  498.             )
  499.           )
  500.         )
  501.         (if brk_e1 (setq brk_e1 nil))
  502.         (if brk_e2 (setq brk_e2 nil))
  503.         (command "_.UNDO" "_EN")
  504.       )                               ; end of inner cond
  505.     )                                 ; end of outer cond
  506.   )                                   ; end of while
  507. )
  508. ;;; ------------------ End Main Functions ---------------------------
  509. ;;; ---------------- Begin Support Functions ------------------------
  510.  
  511.  
  512. ;;;
  513. ;;; Close the DLINE with either straight or arc segments.
  514. ;;; If closing with arcs, the minimum number of segments already drawn
  515. ;;; is 1, otherwise it is 2.
  516. ;;;
  517. ;;; dl_cls == DLine_CLose_Segments
  518. ;;;
  519. (defun dl_cls ()
  520.   (if (or (and (null dl_arc) (< uctr 4)
  521.                (if (> uctr 1)
  522.                  (/= (dl_val 0 (entlast)) "ARC")
  523.                  (not (> uctr 1))
  524.                )
  525.           )
  526.           (and dl_arc (< uctr 2)))
  527.     (progn
  528.       (princ "\n╡L¬k│¼ªX í╨ ╜u (⌐╖) ¼qñ╙ñ╓íC")
  529.       (if dl_arc
  530.         (setq nextpt "Arc")
  531.         (setq nextpt "Line")
  532.       )
  533.     )
  534.     (progn
  535.       (command "_.UNDO" "_GROUP")
  536.       (setq nextpt (nth 0 spts))
  537.       (if (null dl_arc)
  538.         ;; Close with line segments
  539.         (dl_mlf 3)
  540.         (progn
  541.           (setq tmp (last wnames)
  542.                 ange (trans '(1 0 0) (dl_val -1 tmp) 1)
  543.                 ange (angle '(0 0 0) ange)
  544.                 dir (if (= (dl_val 0 tmp) "LINE")
  545.                       (angle (trans (dl_val 10 tmp) 0 1)
  546.                              (trans (dl_val 11 tmp) 0 1))
  547.                       (progn
  548.                         (setq dir (+ (dl_val 50 tmp) ange)
  549.                               dir (if (> dir (* 2 pi))
  550.                                     (- dir (* 2 pi))
  551.                                     dir
  552.                                   )
  553.                         )
  554.                         (if (equal dir
  555.                                    (setq dir (angle (trans (dl_val 10 tmp)
  556.                                                            (dl_val -1 tmp)
  557.                                                            1)
  558.                                                     strtpt
  559.                                              )
  560.                                    )
  561.                                    0.01)
  562.                           (- dir (/ pi 2))
  563.                           (+ dir (/ pi 2))
  564.                         )
  565.                       )
  566.                     )
  567.           )
  568.           (command "_.ARC"
  569.                    strtpt
  570.                    "_E"
  571.                    nextpt
  572.                    "_D"
  573.                    (* dir (/ 180 pi))
  574.           )
  575.           ;; Close with arc segments
  576.           (dl_mlf 4)
  577.         )
  578.       )
  579.       ;; set nextpt to "CLose" which will cause an exit.
  580.       (setq nextpt "CLose"
  581.             v:stpt nil
  582.             cont   nil
  583.       )
  584.     )
  585.   )
  586. )
  587. ;;;
  588. ;;; A point was entered, do either an arc or line segment.
  589. ;;;
  590. ;;; dl_ds == DLine_Do_Segment
  591. ;;;
  592. (defun dl_ds ()
  593.   (if (equal strtpt nextpt 0.0001)
  594.     (progn
  595.       (princ "\n┬Iª∞¼█ªP (ª@┬I) í╨ ╜╨ªA╕╒íC")
  596.       (if dl_arc
  597.         (setq nextpt "Arc")
  598.         (setq nextpt "Line")
  599.       )
  600.     )
  601.     (progn
  602.       (command "_.UNDO" "_GROUP")
  603.       (setq nextpt (list (car nextpt) (cadr nextpt) (caddr strtpt)))
  604.       (if dl_arc
  605.         (progn
  606.           (command "_.ARC" strtpt nextpt)
  607.           (prompt "\n▓╫ñε┬I: ")
  608.           (command pause)
  609.           (setq nextpt (getvar "lastpoint")
  610.                 v:stpt nextpt)
  611.           (setq temp (entlast))
  612.           ;; Delete the last arc segment so we can find the line or
  613.           ;; arc under it.
  614.           (entdel temp)
  615.           (if dl:snp
  616.             (dl_ved "brk_e2" nextpt)
  617.           )
  618.           ;; Restore the arc previously deleted.
  619.           (entdel temp)
  620.           ;; Draw the arc segments.
  621.           (dl_mlf 2)
  622.         )
  623.         (progn
  624.           (setq v:stpt nextpt)
  625.           (if dl:snp
  626.             (dl_ved "brk_e2" nextpt)
  627.           )
  628.           (if (and brk_e1 (eq brk_e1 brk_e2) (= (dl_val 0 brk_e1) "LINE"))
  629.             (progn
  630.               (princ "\níu▓─ñG┬IívñúÑiªbªPñ@╜uñWíC")
  631.               (setq brk_e2 nil)
  632.             )
  633.             ;; Draw the line segments.
  634.             (dl_mlf 1)
  635.           )
  636.         )
  637.       )
  638.       (if brk_e2 (setq nextpt "Quit"))
  639.     )
  640.   )
  641. )
  642. ;;;
  643. ;;; The CEnter option for drawing arc segments was selected.
  644. ;;;
  645. ;;; dl_ceo == DLine_CEnter_Option
  646. ;;;
  647. (defun dl_ceo ()
  648.   (command "_.UNDO" "_GROUP")
  649.   (setq temp T)
  650.   (while temp
  651.     (initget 1)
  652.     (setq cpt (getpoint strtpt "\nCenter point: "))
  653.     (if (<= (distance cpt strtpt) (- (/ (getvar "tracewid") 2.0) dl:osd))
  654.       (progn
  655.         (princ
  656.         "\nÑHÑ╪½e┬∙╜u¬║íu╝e½╫ívª╙¿Ñ, ┐∩⌐wñº")
  657.         (princ "\níuñññ▀┬Iív⌐╥⌐w╕q¬║íuÑb«|ívñ╙ñp; ")
  658.         (princ "╜╨┐∩╛▄Ñtñ@┬IíC")
  659.       )
  660.       (setq temp nil)
  661.     )
  662.   )
  663.   ;; Start the ARC command so that we can get visual dragging.
  664.   (command "_.ARC" strtpt "_C" cpt)
  665.   (initget "Angle Length Endpoint")
  666.   (setq nextpt (getkword "\nA¿ñ½╫/L⌐╢¬°/<E▓╫ñε┬I>: "))
  667.   (cond
  668.     ((= nextpt "Angle")
  669.       (prompt "\n⌐╖¿ñ: ")
  670.       (command "_A" pause)
  671.       (setq nextpt (dl_vnp)
  672.             v:stpt nextpt
  673.       )
  674.       ;; Draw the arc segments.
  675.       (dl_mlf 2)
  676.     )
  677.     ((= nextpt "Length")
  678.       (prompt "\n⌐╢¬°: ")
  679.       (command "_L" pause)
  680.       (setq nextpt (dl_vnp)
  681.             v:stpt nextpt
  682.       )
  683.       ;; Draw the arc segments.
  684.       (dl_mlf 2)
  685.     )
  686.     (T
  687.       (prompt "\n▓╫ñε┬I: ")
  688.       (command pause)
  689.       (setq nextpt (dl_vnp)
  690.             v:stpt nextpt
  691.       )
  692.       ;; Draw the arc segments.
  693.       (dl_mlf 2)
  694.     )
  695.   )
  696. )
  697. ;;;
  698. ;;; Endpoint option was selected.
  699. ;;;
  700. ;;; dl_epo == DLine_End_Point_Option
  701. ;;;
  702. (defun dl_epo ()
  703.   (command "_.UNDO" "_GROUP")
  704.   (initget 1)
  705.   (setq cpt (getpoint "\n▓╫ñε┬I: "))
  706.   ;; Start the ARC command so that we can get visual dragging.
  707.   (command "_.ARC" strtpt "_E" cpt)
  708.   (initget "Angle Direction Radius Center")
  709.   (setq nextpt (getkword "\nA¿ñ½╫/Dñ┴╜uñΦªV/RÑb«|/<Cñññ▀┬I>: "))
  710.   (cond
  711.     ((= nextpt "Angle")
  712.       (prompt "\n⌐╖¿ñ: ")
  713.       (command "_A" pause)
  714.       (setq nextpt (dl_vnp)
  715.             v:stpt nextpt
  716.       )
  717.       ;; Draw the arc segments.
  718.       (dl_mlf 2)
  719.     )
  720.     ((= nextpt "Direction")
  721.       (prompt "\nñ┴╜uñΦªV: ")
  722.       (command "_D" pause)
  723.       (setq nextpt (dl_vnp)
  724.             v:stpt nextpt
  725.       )
  726.       ;; Draw the arc segments.
  727.       (dl_mlf 2)
  728.     )
  729.     ((= nextpt "Radius")
  730.       (setq temp T)
  731.       (while temp
  732.         (initget 1)
  733.         (setq rad (getdist cpt "\nÑb«|: "))
  734.  
  735.         (if (or (<= rad (/ (getvar "tracewid") 2.0))
  736.                 (< rad (/ (distance strtpt cpt) 2.0)))
  737.           (progn
  738.             (princ "\nÑH┐∩⌐w¬║íu▓╫ñε┬Iívª╙¿Ñ, ┐ΘñJ¬║íuÑb«|ív╡L«─, ")
  739.             (princ "⌐╬¼O < íu1/2 ┬∙╜u╝e½╫ív; ")
  740.             (princ "\n╜╨┐ΘñJ > ")
  741.             (if (< (/ (getvar "tracewid") 2.0)
  742.                    (/ (distance strtpt cpt) 2.0))
  743.               (princ (rtos (/ (distance strtpt cpt) 2.0)))
  744.               (princ (rtos (/ (getvar "tracewid") 2.0)))
  745.             )
  746.             (princ " ¬║Ñb«|íC")
  747.           )
  748.           (setq temp nil)
  749.         )
  750.       )
  751.       (command "_R" rad)
  752.       (setq nextpt (dl_vnp)
  753.             v:stpt nextpt
  754.       )
  755.       ;; Draw the arc segments.
  756.       (dl_mlf 2)
  757.     )
  758.     (T
  759.       (prompt "\nñññ▀┬I: ")
  760.       (command pause)
  761.       (setq nextpt (dl_vnp)
  762.             v:stpt nextpt
  763.       )
  764.       ;; Draw the arc segments.
  765.       (dl_mlf 2)
  766.     )
  767.   )
  768. )
  769. ;;;
  770. ;;; Set the ending save points for capping the DLINE.
  771. ;;;
  772. ;;; dl_ssp == DLine_Set_Save_Points
  773. ;;;
  774. (defun dl_ssp ( / temp)
  775.   (setq temp (length savpts))
  776.   (if (> temp 1)
  777.     (progn
  778.       (setq savpt3 (nth (- temp 2) savpts)
  779.             savpt4 (nth (- temp 1) savpts)
  780.       )
  781.     )
  782.   )
  783. )
  784. ;;;
  785. ;;; Set the alignment of the "ghost" line to one of the following values:
  786. ;;;
  787. ;;;   Left   == -1/2 of width (Real number)
  788. ;;;           > -1/2 of width (Real number)
  789. ;;;   Center == 0.0
  790. ;;;           < +1/2 of width (Real number)
  791. ;;;   Right  == +1/2 of width (Real number)
  792. ;;;
  793. ;;; All of the alignment options are taken as if you are standing at the
  794. ;;; start point of the line or arc looking toward the end point, with
  795. ;;; left and negative values being on the left, center or 0.0 being
  796. ;;; directly in line, and right or positive on the right.
  797. ;;;
  798. ;;; Entering a real number equal to 1/2 of the width sets an absolute offset
  799. ;;; distance from the centerline, while specifying the same offset distance
  800. ;;; with the keywords tells the routine to change the offset distance to
  801. ;;; match 1/2 of the width, whenever it is changed.
  802. ;;;
  803. ;;; NOTE:  If you wish to allow the dragline to be positioned outside
  804. ;;;      of the two arcs or lines being created, you may set the local
  805. ;;;      variable "dragos" = T, on the 4th line of the defun, which
  806. ;;;      checks that the offset value entered is not greater or less
  807. ;;;      than + or - TRACEWID / 2.
  808. ;;;
  809. ;;;      You should be aware that the results of allowing this to occur
  810. ;;;      may not be obvious or necessarily correct.  Specifically, when
  811. ;;;      drawing lines with a width of 1 and an offset of 4, if you draw
  812. ;;;      segments as follows, the lines will cross back on themselves.
  813. ;;;
  814. ;;;      dl 0,0,0 10,0,0 10,5 then 5,5
  815. ;;;
  816. ;;;      However, this can be quite useful for creating parallel DLINE's.
  817. ;;;
  818. ;;; dl_sao == DLine_Set_Alignment_Option
  819. ;;;
  820. (defun dl_sao (/ temp dragos)
  821.   (initget "Left Center Right")
  822.   (setq temp dl:osd)
  823.   ;;(setq dragos T)                   ; See note above.
  824.   (setq dl:osd (getreal (strcat
  825.     "\níu⌐∞ñ▐╜uív¬║ª∞╕m⌐wªb LѬ/Cññ/RÑk/<Ñ╤ñññ▀░╛▓╛="
  826.     (rtos dl:osd) ">: ")))
  827.   (cond
  828.     ((= dl:osd "Left")
  829.       (setq dl:aln 1
  830.             dl:osd (- (/ (getvar "tracewid") 2.0))
  831.       )
  832.     )
  833.     ((= dl:osd "Center")
  834.       (setq dl:aln 0
  835.             dl:osd 0.0
  836.       )
  837.     )
  838.     ((= dl:osd "Right")
  839.       (setq dl:aln 2
  840.             dl:osd (/ (getvar "tracewid") 2.0)
  841.       )
  842.     )
  843.     ((= (type dl:osd) 'REAL)
  844.       (if dragos
  845.         (setq dl:aln nil)
  846.         (progn
  847.           (setq dl:aln nil)
  848.           (if (> dl:osd (/ (getvar "tracewid") 2.0))
  849.             (progn
  850.               (princ "\n┐ΘñJ╝╞¡╚╢WÑX╜d│≥; ¡½╕m¼░ ")
  851.               (princ (/ (getvar "tracewid") 2.0))
  852.               (setq dl:osd (/ (getvar "tracewid") 2.0))
  853.             )
  854.           )
  855.           (if (< dl:osd (- (/ (getvar "tracewid") 2.0)))
  856.             (progn
  857.               (princ "\n┐ΘñJ╝╞¡╚╢WÑX╜d│≥; ¡½╕m¼░ ")
  858.               (princ (- (/ (getvar "tracewid") 2.0)))
  859.               (setq dl:osd (- (/ (getvar "tracewid") 2.0)))
  860.             )
  861.           )
  862.         )
  863.       )
  864.     )
  865.     (T
  866.       (setq dl:osd temp)
  867.     )
  868.   )
  869. )
  870. ;;;
  871. ;;; Set a new DLINE width.
  872. ;;;
  873. ;;; dl_snw == DLine_Set_New_Width
  874. ;;;
  875. (defun dl_snw ()
  876.   (initget 6)
  877.   (setvar "tracewid"
  878.     (if (setq temp (getdist (strcat
  879.       "\n╖s¬║íu┬∙╜u╝e½╫ív<" (rtos (getvar "tracewid")) ">: ")))
  880.       temp
  881.       (getvar "tracewid")
  882.     )
  883.   )
  884.   (if dl:aln
  885.     (cond
  886.       ((= dl:aln 1) ; left aligned
  887.         (setq dl:osd (- (/ (getvar "tracewid") 2.0)))
  888.       )
  889.       ((= dl:aln 2) ; right aligned
  890.         (setq dl:osd (/ (getvar "tracewid") 2.0))
  891.       )
  892.       (T
  893.         (princ)     ; center aligned
  894.       )
  895.     )
  896.   )
  897. )
  898. ;;;
  899. ;;; Get an offset from a given point to the start point toward a second
  900. ;;; point.  The distance between the two points is the default, but any
  901. ;;; positive distance may be entered.  If a negative number is entered,
  902. ;;; it is used as a percentage distance from the "Offset from" point
  903. ;;; toward the "Offset toward" point, i.e., if -75 is entered, a point
  904. ;;; 75% of the distance between the two points listed above is returned.
  905. ;;;
  906. ;;;
  907. ;;; dl_ofs == DLine_OFfset_Startpoint
  908. ;;;
  909. (defun dl_ofs ()
  910.   (menucmd "s=osnapb")
  911.   (initget 1)
  912.   (setq strtpt (getpoint "\n░╛▓╛í╨░≥╖╟┬I: "))
  913.   (initget 1)
  914.   (setq nextpt (getpoint strtpt "\n░╛▓╛í╨ñΦªV: "))
  915.  
  916.   (setq dist (getdist strtpt (strcat
  917.     "\n┐ΘñJíu░╛▓╛╢Z┬≈ív<" (rtos (distance strtpt nextpt))
  918.     ">: ")))
  919.   (setq dist (if (or (= dist "") (null dist))
  920.                (distance strtpt nextpt)
  921.                (if (< dist 0)
  922.                  (* (distance strtpt nextpt) (/ (abs dist) 100.0))
  923.                  dist
  924.                )
  925.              )
  926.   )
  927.   (setq strtpt (polar strtpt
  928.                       (angle strtpt nextpt)
  929.                       dist
  930.                )
  931.   )
  932.   (setq temp nil)
  933.   (command "_.UNDO" "_GROUP")
  934. )
  935. ;;;
  936. ;;; Set snap options to ON, OFF or set the size of the area to be searched
  937. ;;; by (ssget point) via "pickbox".  This value is being limited for built-
  938. ;;; in display drivers at 10 pixels.  For ADI drivers it may be necessary
  939. ;;; to bump up this number by adjusting "MAXSNP" at the top of this file.
  940. ;;;
  941. ;;; dl_sso == DLine_Set_Snap_Options
  942. ;;;
  943. (defun dl_sso ()
  944.   (initget "ON OFf Size")
  945.   (setq ans (getkword
  946.     "\n│]⌐wíu┬Ω┬Iñ╪ñoív⌐╬íu┬Ω┬I On/Offíví╨ Sñ╪ño/OFF/<ON>: "))
  947.   (if (= ans "OFf")
  948.     (progn
  949.       (setq dl:snp nil)
  950.       (setvar "pickbox" 0)
  951.     )
  952.     (if (= ans "Size")
  953.       (progn
  954.         (setq dl:snp T ans 0)
  955.         (while (or (< ans 1) (> ans MAXSNP))
  956.           (setq ans (getint (strcat
  957.             "\n╖s¬║┬Ω┬Iñ╪ño (1 - " (itoa MAXSNP) ") <" (itoa dl:opb) ">: ")))
  958.  
  959.           (if (or (= ans "") (null ans))
  960.             (setq ans dl:opb)
  961.           )
  962.         )
  963.         (setvar "pickbox" ans)
  964.         (setq dl:opb ans)
  965.       )
  966.       (progn
  967.         (setq dl:snp T)
  968.         (setvar "pickbox" dl:opb)
  969.       )
  970.     )
  971.   )
  972.   (if dl:snp
  973.     (if (= uctr 0)
  974.       (dl_ved "brk_e1" strtpt)
  975.     )
  976.   )
  977.   (if dl_arc
  978.     (setq nextpt "Arc")
  979.     (setq nextpt "Line")
  980.   )
  981.  
  982. )
  983. ;;;
  984. ;;; Obtain and verify the extrusion direction of an entity at the
  985. ;;; start point or endpoint of the line or arc we are drawing.
  986. ;;;
  987. ;;; dl_ved == DLine_Verify_Extrusion_Direction
  988. ;;;
  989. (defun dl_ved (vent pt)
  990.   ;; Get entity to break if the user snapped to a DLINE.
  991.   ;; Make sure that it is a line or arc and that its extrusion
  992.   ;; direction is parallel to the current UCS.
  993.   (if (set (read vent) (ssget pt))
  994.     (progn
  995.       (set (read vent) (ssname (eval (read vent)) 0))
  996.       (if (and
  997.             (or (= (dl_val 0 (eval (read vent))) "ARC")
  998.                 (= (dl_val 0 (eval (read vent))) "LINE")
  999.             )
  1000.             (equal (caddr(dl_val 210 (eval (read vent))))
  1001.                    (caddr(trans '(0 0 1) 1 0)) 0.001)
  1002.           )
  1003.         (princ)
  1004.         (progn
  1005.           (princ (strcat
  1006.             "\nª╣íu╣╧ñ╕ívñú¼░íu⌐╖ív⌐╬íu╜uív, "
  1007.             "⌐╬¼OñúÑ¡ªµ⌐≤Ñ╪½e UCS íC"))
  1008.           (set (read vent) nil)
  1009.         )
  1010.       )
  1011.     )
  1012.   )
  1013.   (eval (read vent))
  1014. )
  1015. ;;;
  1016. ;;; Verify nextpt.
  1017. ;;; Get the point on the arc at the opposite
  1018. ;;; end from the start point (strtpt).
  1019. ;;;
  1020. ;;; dl_vnp == DLine_Verify_NextPt
  1021. ;;;
  1022. (defun dl_vnp (/ temp cpt ang rad)
  1023.  
  1024.   (setq temp (entlast))
  1025.   (if (= (dl_val 0 temp) "LINE")
  1026.     (setq nextpt (if (equal strtpt (dl_val 10 temp) 0.001)
  1027.                    (dl_val 11 temp)
  1028.                    (dl_val 10 temp)
  1029.                  )
  1030.     )
  1031.     ;; Then it must be an arc...
  1032.     (progn
  1033.       ;; get its center point
  1034.       (setq cpt  (trans (dl_val 10 temp) (dl_val -1 temp) 1)
  1035.             ang  (dl_val 50 temp)     ; starting angle
  1036.             rad  (dl_val 40 temp)     ; radius
  1037.       )
  1038.       (setq ange (trans '(1 0 0) (dl_val -1 temp) 1)
  1039.             ange (angle '(0 0 0) ange)
  1040.             ang (+ ang ange)
  1041.       )
  1042.       (if (> ang (* 2 pi))
  1043.         (setq ang (- ang (* 2 pi)))
  1044.       )
  1045.       (setq nextpt (if (equal strtpt (polar cpt ang rad) 0.01)
  1046.                      (polar cpt (dl_val 51 temp) rad)
  1047.                      (polar cpt ang rad)
  1048.                    )
  1049.       )
  1050.     )
  1051.   )
  1052. )
  1053. ;;; ----------------- Main Line Drawing Function -------------------
  1054. ;;;
  1055. ;;; Draw the lines.
  1056. ;;;
  1057. ;;; dl_mlf == DLine_Main_Line_Function
  1058. ;;;
  1059. (defun dl_mlf (flg / temp1 temp2 newang ang1 ang2
  1060.                      ent cpt ang rad1 rad2 sent1 sent2
  1061.                      tmpt1 tmpt2 tmpt3 tmpt4)
  1062.  
  1063.   ;; Verify nextpt
  1064.   (if (null nextpt) (setq nextpt (dl_vnp)))
  1065.  
  1066.   (if (equal nextpt (nth 0 spts) 0.01)
  1067.     (if dl_arc
  1068.       (setq flg 4)
  1069.       (setq flg 3)
  1070.     )
  1071.   )
  1072.  
  1073.   (setq temp1  (+ (/ (getvar "tracewid") 2.0) dl:osd)
  1074.         temp2  (- (getvar "tracewid") temp1)
  1075.         newang (angle strtpt nextpt)
  1076.         ang1   (+ (angle strtpt nextpt) (/ pi 2))
  1077.         ang2   (- (angle strtpt nextpt) (/ pi 2))
  1078.   )
  1079.   (cond
  1080.     ((= flg 1)                        ; if drawing lines
  1081.       (dl_dls nil ang1 temp1)         ; Draw line segment 1
  1082.       (dl_dls nil ang2 temp2)         ; Draw line segment 2
  1083.     )
  1084.     ((or (= flg 2) (= flg 4))         ; else drawing arcs...
  1085.       (setq tmp (entlast)             ; get the last arc entity
  1086.             ent  (entget tmp)         ; (i.e., the guideline)
  1087.             ;; get its center point
  1088.             cpt  (trans (dl_val 10 tmp) (dl_val -1 tmp) 1)
  1089.             ang  (dl_val 50 tmp)      ; starting angle
  1090.       )
  1091.       (setq ange (trans '(1 0 0) (dl_val -1 tmp) 1)
  1092.             ange (angle '(0 0 0) ange)
  1093.             ang (+ ang ange)
  1094.       )
  1095.       (if (> ang (* 2 pi))
  1096.         (setq ang (- ang (* 2 pi)))
  1097.       )
  1098.  
  1099.       ;; if start angle needs revision
  1100.       (if (equal (angle cpt strtpt) ang 0.01)
  1101.         (progn
  1102.           ;; Start angle needs revision.
  1103.           (setq strt_a T
  1104.                 rad1  (+ (dl_val 40 tmp) temp2) ; outer radius
  1105.                 rad2  (- (dl_val 40 tmp) temp1) ; inner radius
  1106.           )
  1107.           (setq ent (subst (cons 40 rad2) ; modify its radius
  1108.                            (assoc 40 ent)
  1109.                            ent))
  1110.           (entmod ent)
  1111.           (dl_atl)                    ; Add ename to list
  1112.           (setq save_1 ent)
  1113.           (setq sent1 (dl_val -1 tmp))
  1114.           (if (= flg 4)
  1115.             (if (> uctr 2)
  1116.               (dl_das 0 rad2 50)      ; modify arc endpt and close
  1117.             )
  1118.             (dl_das nil rad2 50)      ; else modify arc endpt
  1119.           )
  1120.           ;; Create the "parallel" arc
  1121.           (command "_.OFFSET" (getvar "tracewid") ; offset the arc
  1122.                               (list tmp '(0 0 0))
  1123.                               (polar cpt ang (+ 1 rad1 rad2))
  1124.                               "")
  1125.           (setq tmp (entlast)         ; get the offset arc
  1126.                 ent  (entget tmp))
  1127.           (dl_atl)                    ; Add ename to list
  1128.           (setq save_2 ent)
  1129.           (setq sent2 tmp)
  1130.           (if (= flg 4)
  1131.             (if (> uctr 3)
  1132.               (progn
  1133.                 (dl_das 1 rad1 50)    ; modify arc endpt and close
  1134.  
  1135.                 ;; set nextpt to "CLose" which will cause an exit.
  1136.                 (setq nextpt "CLose"
  1137.                       v:stpt nil
  1138.                       cont   nil
  1139.                 )
  1140.               )
  1141.             )
  1142.             (dl_das nil rad1 50)      ; else modify arc endpt
  1143.           )
  1144.  
  1145.         )
  1146.         (progn                        ; if end angle needs revision
  1147.           ;; End angle needs revision.
  1148.           (setq strt_a nil
  1149.                 rad1  (+ (dl_val 40 tmp) temp1) ; outer radius
  1150.                 rad2  (- (dl_val 40 tmp) temp2) ; inner radius
  1151.           )
  1152.           (setq ent (subst (cons 40 rad1) ; modify its radius
  1153.                            (assoc 40 ent)
  1154.                            ent))
  1155.           (entmod ent)
  1156.           (dl_atl)                    ; Add ename to list
  1157.           (setq save_1 ent)
  1158.           (setq sent1 (dl_val -1 tmp))
  1159.           (if (= flg 4)
  1160.             (if (> uctr 2)
  1161.               (dl_das 0 rad1 51)      ; modify arc endpt and close
  1162.             )
  1163.             (dl_das nil rad1 51)      ; else modify arc endpt
  1164.           )
  1165.           ;; Create the "parallel" arc
  1166.           (command "_.OFFSET" (getvar "tracewid")
  1167.                             (list tmp '(0 0 0))
  1168.                             cpt
  1169.                             "")
  1170.           (setq tmp (entlast)         ; get the last arc entity
  1171.                 ent  (entget tmp))
  1172.           (dl_atl)                    ; Add ename to list
  1173.           (setq save_2 ent)
  1174.           (setq sent2 tmp)
  1175.           (if (= flg 4)
  1176.             (if (> uctr 3)
  1177.               (progn
  1178.                 (dl_das 1 rad2 51)    ; modify arc endpt and close
  1179.  
  1180.                 ;; set nextpt to "CLose" which will cause an exit.
  1181.                 (setq nextpt "CLose"
  1182.                       v:stpt nil
  1183.                       cont   nil
  1184.                 )
  1185.               )
  1186.             )
  1187.             (dl_das nil rad2 51)      ; else modify arc endpt
  1188.           )
  1189.         )
  1190.       )
  1191.  
  1192.     )
  1193.     ((= flg 3)                        ; if straight closing
  1194.       (setq nextpt (nth 0 spts)
  1195.             ang1   (+ (angle strtpt nextpt) (/ pi 2))
  1196.             ang2   (- (angle strtpt nextpt) (/ pi 2))
  1197.       )
  1198.       (dl_dls 0 ang1 temp1)
  1199.       (dl_dls 1 ang2 temp2)
  1200.  
  1201.       ;; set nextpt to "CLose" which will cause an exit.
  1202.       (setq nextpt "CLose"
  1203.             v:stpt nil
  1204.             cont   nil
  1205.       )
  1206.     )
  1207.     (T
  1208.       (princ "\n┐∙╗~: ╝╞¡╚╢WÑX╜d│≥íC")
  1209.       (exit)
  1210.     )
  1211.   )
  1212.   (setq strtpt nextpt
  1213.         spts   (append spts (list strtpt))
  1214.         savpts (append savpts (list savpt3))
  1215.         savpts (append savpts (list savpt4))
  1216.   )
  1217.   (command "_.UNDO" "_E")                ; only end when DLINE's have been drawn
  1218. )
  1219. ;;; ------------------- End Support Functions -----------------------
  1220. ;;; ---------------- Begin Line Drawing Functions -------------------
  1221. ;;;
  1222. ;;; Straight DLINE function
  1223. ;;;
  1224. ;;; dl_dls == DLine_Draw_Line_Segment
  1225. ;;;
  1226. (defun dl_dls (flgn ang temp / j k pt1 pt2 tmp1 ent1 p1 p2)
  1227.  
  1228.   (mapcar                             ; get endpoints of the offset line
  1229.     '(lambda (j k)
  1230.        (set j (polar (eval k) ang temp))
  1231.      )
  1232.      '(pt1 pt2)
  1233.      '(strtpt nextpt)
  1234.   )
  1235.   (cond
  1236.     ((= uctr 0)
  1237.       ;; Set points 1 and 2 for segment 1.
  1238.       (setq p1 (if (dl_l01 brk_e1 "1" pt1 pt2 strtpt) ipt savpt1))
  1239.       (setq pt2 (if (dl_l01 brk_e2 "3" pt2 pt1 nextpt) ipt savpt3))
  1240.       (setq pt1 p1)
  1241.     )
  1242.     ((= uctr 1)
  1243.       ;; Set points 1 and 2 for segment 2.
  1244.       (setq p1 (if (dl_l01 brk_e1 "2" pt1 pt2 strtpt) ipt savpt2))
  1245.       (setq pt2 (if (dl_l01 brk_e2 "4" pt2 pt1 nextpt) ipt savpt4))
  1246.       (setq pt1 p1)
  1247.  
  1248.       ;; Now break the line or arc found at the start point
  1249.       ;; if there is one, and we are in a breaking mood.
  1250.       (if (and dl:brk brk_e1)
  1251.         (progn
  1252.           (command "_.BREAK" brk_e1 savpt1 savpt2)
  1253.         )
  1254.       )
  1255.       ;; Now break the line or arc found at the end point
  1256.       ;; if there is one, and we are in a breaking mood.
  1257.       (if (and dl:brk brk_e2)
  1258.         (progn
  1259.           (if (eq brk_e1 brk_e2)
  1260.             (progn
  1261.               ;; Delete first line so we can find the arc or line that
  1262.               ;; we found previously.
  1263.               (entdel (nth 0 wnames))
  1264.               (dl_ved "brk_e2" nextpt)
  1265.               ;; Restore first line
  1266.               (entdel (nth 0 wnames))
  1267.             )
  1268.           )
  1269.           (command "_.BREAK" brk_e2 savpt3 savpt4)
  1270.         )
  1271.       )
  1272.       ;; Do not set brk_e2 nil... it will be set later.
  1273.     )
  1274.     ((= (rem uctr 2.0) 0)
  1275.       (setq fang nil)
  1276.       (setq p1 (dl_dl2 pt1))          ; Draw line part 2
  1277.       (setq pt2 (if (dl_l01 brk_e2 "3" pt2 pt1 strtpt)
  1278.                   ipt
  1279.                   savpt3
  1280.                 )
  1281.       )
  1282.       (setq pt1 p1)
  1283.       (if flgn                        ; if closing
  1284.         (progn
  1285.           (setq tmp1 (nth flgn wnames)
  1286.                 ent1 (entget tmp1)    ; get the corresponding prev. entity
  1287.           )
  1288.           (if (= (dl_val 0 tmp1) "LINE")
  1289.             ;; if it's a line
  1290.             (setq pt2 (dl_mls nil 10))
  1291.             ;; if it's an arc
  1292.             (setq pt2 (dl_mas T nil pt2 pt1 nil))
  1293.           )
  1294.         )
  1295.       )
  1296.     )
  1297.     (T
  1298.       (setq p1 (dl_dl2 pt1))              ; Draw line part 2
  1299.       (setq pt2 (if (dl_l01 brk_e2 "4" pt2 pt1 nextpt)
  1300.                   ipt
  1301.                   savpt4
  1302.                 )
  1303.       )
  1304.       (setq pt1 p1)
  1305.       (if flgn                        ; if closing
  1306.         (progn
  1307.           (setq tmp1 (nth flgn wnames)
  1308.                 ent1 (entget tmp1)    ; get the corresponding prev. entity
  1309.                 brk_e1 nil
  1310.                 brk_e2 nil
  1311.           )
  1312.           (if (= (dl_val 0 tmp1) "LINE")
  1313.             ;; if it's a line
  1314.             (setq pt2 (dl_mls nil 10))
  1315.             ;; if it's an arc
  1316.             (setq pt2 (dl_mas T nil pt2 pt1 nil))
  1317.           )
  1318.         )
  1319.       )
  1320.       ;; Now break the line or arc found at the end point
  1321.       ;; if there is one, and we are in a breaking mood.
  1322.       (if (and dl:brk brk_e2)
  1323.         (progn
  1324.           (command "_.BREAK" brk_e2 savpt3 savpt4)
  1325.         )
  1326.       )
  1327.       ;; Do not set brk_e2 nil... it will be set later.
  1328.     )
  1329.   )
  1330.   (command "_.LINE" pt1 pt2 "")         ; draw the line
  1331.   (setq wnames (if (null wnames)
  1332.                  (list (setq elast (entlast)) )
  1333.                  (append wnames (list (setq elast (entlast)))))
  1334.         uctr   (1+ uctr)
  1335.   )
  1336.   wnames
  1337. )
  1338. ;;;
  1339. ;;; Set pt1 or pt2 based on whether there is an arc or line to be broken.
  1340. ;;;
  1341. ;;; dl_l01 == DLine_draw_Lines_0_and_1
  1342. ;;;
  1343. (defun dl_l01 (bent1 n p1 p2 pt / temp)
  1344.   (setq n (strcat "savpt" n))
  1345.   (setq spt nil)
  1346.   (if bent1
  1347.     (if (= (dl_val 0 bent1) "LINE")
  1348.       (progn
  1349.         (setq temp (inters (trans (dl_val 10 bent1) 0 1)
  1350.                             (trans (dl_val 11 bent1) 0 1)
  1351.                             p1
  1352.                             p2
  1353.                             nil
  1354.                     )
  1355.         )
  1356.         (if temp
  1357.           (set (read n) temp)
  1358.           (progn
  1359.             (set (read n) p1)
  1360.             (setq brk_e1 nil)
  1361.           )
  1362.         )
  1363.       )
  1364.       (progn
  1365.         (set (read n) (dl_ial bent1 p1 p2 pt))
  1366.         ;; Spt is set only if there was no intersection point.
  1367.         (if spt
  1368.           (progn
  1369.             (setq ipt (eval (read n)))
  1370.             (set (read n) spt)
  1371.           )
  1372.         )
  1373.       )
  1374.     )
  1375.     (set (read n) p1)
  1376.   )
  1377.   (if spt
  1378.     T
  1379.     nil
  1380.   )
  1381. )
  1382. ;;;
  1383. ;;; Do more of the line drawing stuff.  This is where we call the modify
  1384. ;;; functions for the previous arc or line segment.  The line end being
  1385. ;;; modified is always the group 11 end, but we have to test the start
  1386. ;;; and end angle of an arc to tell which end to modify.
  1387. ;;;
  1388. ;;; dl_dl2 == DLine_Draw_Line_segment_part_2
  1389. ;;;
  1390. (defun dl_dl2 (npt)
  1391.   (setq tmp1 (nth (- uctr 2) wnames)
  1392.         ent1 (entget tmp1))           ; get the corresponding prev. entity
  1393.  
  1394.   (if (= (dl_val 0 tmp1) "LINE")
  1395.     ;; Check angles 0 180, -180  and 360...
  1396.     (if (or  (equal (angle strtpt nextpt)
  1397.                    (angle (trans (dl_val 10 tmp1) 0 1)
  1398.                           (trans (dl_val 11 tmp1) 0 1)) 0.001)
  1399.              (equal (angle strtpt nextpt)
  1400.                    (angle (trans (dl_val 11 tmp1) 0 1)
  1401.                           (trans (dl_val 10 tmp1) 0 1)) 0.001)
  1402.              (equal (+ (* 2 pi) (angle strtpt nextpt))
  1403.                    (angle (trans (dl_val 10 tmp1) 0 1)
  1404.                           (trans (dl_val 11 tmp1) 0 1)) 0.001)
  1405.         )
  1406.       ;; if it's a line
  1407.       (progn
  1408.         (setq brk_e2 nil)
  1409.         (command "_.LINE" (trans (dl_val 11 tmp1) 0 1) pt1 "")
  1410.         pt1
  1411.       )
  1412.       ;; else, if it's an arc
  1413.       (progn
  1414.         (dl_mls nil 11)
  1415.       )
  1416.     )
  1417.     ;; if it's an arc
  1418.     (dl_mas nil nil pt1 pt2 strtpt)
  1419.   )
  1420. )
  1421. ;;;
  1422. ;;; Modify line endpoint
  1423. ;;;
  1424. ;;; dl_mls == DLine_Modify_Line_Segment
  1425. ;;;
  1426. (defun dl_mls (flg2 nn / spt ept pt)  ; flg2 = nil if line to line
  1427.                                       ;      = T   if line to arc
  1428.  
  1429.   ;; This is the previous entity; a line
  1430.   (setq spt (trans (dl_val 10 tmp1) 0 1)
  1431.         ept (trans (dl_val 11 tmp1) 0 1)
  1432.   )
  1433.   (if flg2
  1434.     ;; find intersection with arc; tmp == ename of arc
  1435.     (progn
  1436.       ;; Find arc intersection with line; tmp == ename of arc.
  1437.       (setq pt (dl_ial tmp spt ept (if flgn nextpt strtpt)))
  1438.     )
  1439.  
  1440.     ;; find intersection with line
  1441.     (setq pt (inters spt ept pt1 pt2 nil))
  1442.   )
  1443.   ;; modify the previous line
  1444.   (if pt
  1445.     (entmod (subst (cons nn (trans pt 1 0))
  1446.                    (assoc nn ent1)
  1447.                    ent1))
  1448.     (setq pt pt2)
  1449.   )
  1450.   pt
  1451. )
  1452. ;;;
  1453. ;;; This routine does a variety of tasks: it calculate the distance from
  1454. ;;; the center of the arc (or congruent circle) to a line, then it
  1455. ;;; calculates up to two intersection points of a line and the arc,
  1456. ;;; then it attempts to determine which of the points serves as a
  1457. ;;; best-fit to the following criteria:
  1458. ;;;
  1459. ;;;   1) One end of the arc must lie "on" the line, or
  1460. ;;;      one end of the line must lie on the arc.
  1461. ;;;   2) Given that the point given in 1 above is p1,
  1462. ;;;      and that the other point is p2, then if the arc crosses over
  1463. ;;;      the line then use p2, otherwise the arc does not cross over
  1464. ;;;      the line so use p1.
  1465. ;;;
  1466. ;;; If the line and the arc do not intersect, then a line will be drawn
  1467. ;;; from the point of intersection of the arc and the perpendicular from
  1468. ;;; the line to the arc centerpoint, and the line;  The line and arc will be
  1469. ;;; trimmed or extended as needed to meet these points.
  1470. ;;;
  1471. ;;; If the line and arc are tangent, then the arc and line are
  1472. ;;; trimmed/extended to this point.
  1473. ;;;
  1474. ;;; p1 and p2 are two points on a line
  1475. ;;; ename  == entity name of arc
  1476. ;;; flg == T when the segment being drawn ends on an arc,
  1477. ;;; flg == nil when the segment being drawn starts on an arc.
  1478. ;;;
  1479. ;;; dl_ial == DLine_Intersect_Arc_with_Line
  1480. ;;;
  1481. (defun dl_ial (arc pt_1 pt_2 npt / d pi2 rad ang nang temp ipt)
  1482.  
  1483.   (setq cpt  (trans (dl_val 10 arc) (dl_val -1 arc) 1)
  1484.         pi2  (/ pi 2)                 ; 1/2 pi
  1485.         ang  (angle pt_1 pt_2)
  1486.         nang (+ ang pi2)              ; Normal to "ang"
  1487.         temp (inters pt_1 pt_2 cpt (polar cpt nang 1) nil)
  1488.         nang (angle cpt temp)
  1489.   )
  1490.   ;; Get the perpendicular distance from the center of the arc to the line.
  1491.   (setq d (distance cpt temp))
  1492.  
  1493.   (cond
  1494.     ((equal (setq rad (dl_val 40 arc)) d 0.01)
  1495.       ;; One intersection.
  1496.       (setq ipt temp)
  1497.     )
  1498.     ((< rad d)
  1499.       ;; No intersection.
  1500.       (setq spt (polar cpt nang rad)
  1501.             ipt temp
  1502.       )
  1503.       (command "_.LINE" spt ipt "")
  1504.       ipt
  1505.     )
  1506.     (T
  1507.       ;; Two intersections. Now...
  1508.       ;; If drawing arcs, fang is set, we're past the first segment...
  1509.       ;; Reset the `near' point based on the previous ipt.  This can be
  1510.       ;; quite different and necessary from the `npt' passed in.
  1511.       (if (and dl_arc fang (> uctr 1))
  1512.         (setq npt (polar cpt fang rad))
  1513.       )
  1514.       (dl_g2p npt)
  1515.       (setq ipt (dl_bp arc pt_1 pt_2 ipt1 ipt2))
  1516.       ;; If `fang' is not set, set it, otherwise set it to nil.
  1517.       (if fang
  1518.         (setq fang nil)
  1519.         (if dl_arc (setq fang (angle cpt ipt)))
  1520.       )
  1521.       ipt
  1522.     )
  1523.   )
  1524. )
  1525. ;;;
  1526. ;;; Get two intersection points, ordering them such that ipt1
  1527. ;;; is the closer of the two points to the passed-in point "npt".
  1528. ;;;
  1529. ;;; dl_g2p == DLine_Get_2_Points
  1530. ;;;
  1531. (defun dl_g2p (npt / temp l theta)
  1532.   (if (equal d 0.0 0.01)
  1533.     (setq theta pi2
  1534.           nang (+ ang pi2)            ; Normal to "ang"
  1535.     )
  1536.     (setq l     (sqrt (abs (- (expt rad 2) (expt d 2))))
  1537.           theta (abs (atan (/ l d)))
  1538.     )
  1539.   )
  1540.   ;; Get the two angles to the infinite intersection points of the
  1541.   ;; congruent circle to the arc, and the line, then get the two
  1542.   ;; intersection points.
  1543.   (setq ipt1 (polar cpt (- nang theta) rad))
  1544.   (setq ipt2 (polar cpt (+ nang theta) rad))
  1545.   ;; Set the closer of the two points to npt to be ipt1.
  1546.   (if (< (distance ipt2 npt) (distance ipt1 npt))
  1547.     ;; Swap points
  1548.     (setq temp ipt1
  1549.           ipt1 ipt2
  1550.           ipt2 temp
  1551.     )
  1552.     (if (equal (distance ipt2 npt) (distance ipt1 npt) 0.01)
  1553.       (exit)
  1554.     )
  1555.   )
  1556.   ipt1
  1557. )
  1558. ;;;
  1559. ;;; Test a point `pt' to see if it is on the line `sp--ep'.
  1560. ;;;
  1561. ;;; dl_onl == DLine_ON_Line_segment
  1562. ;;;
  1563. (defun dl_onl (sp ep pt / cpt sa ea ang)
  1564.   (if (inters sp ep pt
  1565.               (polar pt (+ (angle sp ep) (/ pi 2))
  1566.                      (/ (getvar "tracewid") 10)
  1567.               )
  1568.               T)
  1569.     T
  1570.     nil
  1571.   )
  1572. )
  1573. ;;;
  1574. ;;; Test a point `pt' to see if it is on the arc `arc'.
  1575. ;;;
  1576. ;;; dl_ona == DLine_ON_Arc_segment
  1577. ;;;
  1578. (defun dl_ona (arc pt / cpt sa ea ang)
  1579.   (setq cpt (trans (dl_val 10 arc) (dl_val -1 arc) 1)
  1580.         sa  (dl_val 50 arc)           ; angle of current ent start point
  1581.         ea  (dl_val 51 arc)           ; angle of current ent end point
  1582.         ang (angle cpt pt)            ; angle to pt.
  1583.   )
  1584.   (if (> sa ea)
  1585.     (if (or (and (> ang sa) (< ang (+ ea (* 2 pi))))
  1586.             (and (> ang (- ea (* 2 pi))) (< ang ea))
  1587.         )
  1588.       T
  1589.       nil
  1590.     )
  1591.     (if (and (> ang sa) (< ang ea)) T nil)
  1592.   )
  1593. )
  1594. ;;;
  1595. ;;; Get the best intersection point of an arc and a line.  The criteria
  1596. ;;; are as follows:
  1597. ;;;
  1598. ;;;   1) The best point will lie on both the arc and the line.
  1599. ;;;   2) It will be the point which causes the shortest arc to be created
  1600. ;;;      such that (1) is satisfied.
  1601. ;;;   3) If closing, then always use the point closest to nextpt.  Unless,
  1602. ;;;      the points are equidistant, then use 1 and 2 above to tiebreak.
  1603. ;;;   4) If breaking an arc with a line, always use the points nearest the
  1604. ;;;      break point.
  1605. ;;;
  1606. ;;; dl_bp == DLine_Best_Point_of_arc_and_line
  1607. ;;;
  1608. (defun dl_bp (en1 p1 p2 pp1 pp2 / temp temp1 temp2)
  1609.   (setq temp1 (dl_onl p1 p2 pp2)
  1610.         temp2 (dl_ona en1 pp2)
  1611.         temp  (if (or (= flg 1) (= flg 3)) T nil)
  1612.   )
  1613.   (if (and temp1 temp2)
  1614.     (if (and (< uctr 2)
  1615.              (and brk_e1 brk_e2))
  1616.       pp1
  1617.       (if (and temp (not fang)) pp1 pp2)
  1618.     )
  1619.     pp1
  1620.   )
  1621. )
  1622. ;;; ----------------- End Line Drawing Functions --------------------
  1623. ;;; ---------------- Begin Arc  Drawing Functions -------------------
  1624. ;;;
  1625. ;;; Draw curved DLINE
  1626. ;;;
  1627. ;;; dl_das == DLine_Draw_Arc_Segment
  1628. ;;;
  1629. (defun dl_das (flgn orad nn / tmp1 ent1 pt ang )
  1630.   (cond
  1631.     ((= uctr 0)
  1632.       (setq sent1 tmp)
  1633.       (dl_a01 brk_e1 "1" strtpt nil)  ; DLine_draw_Arc_0_and_1
  1634.       (dl_a01 brk_e2 "3" nextpt T)    ; DLine_draw_Arc_0_and_1
  1635.     )
  1636.     ((= uctr 1)
  1637.       (setq sent1 tmp)
  1638.       (dl_a01 brk_e1 "2" strtpt nil)  ; DLine_draw_Arc_0_and_1
  1639.       (dl_a01 brk_e2 "4" nextpt T)    ; DLine_draw_Arc_0_and_1
  1640.       (dl_mae nil T)
  1641.       (dl_mae nil nil)
  1642.       ;; Now break the line or arc found at the start point
  1643.       ;; if there is one, and we are in a breaking mood.
  1644.       (if (and dl:brk brk_e1)
  1645.         (progn
  1646.           (dl_mae T T)
  1647.           (dl_mae T nil)
  1648.           (command "_.BREAK" brk_e1 savpt1 savpt2)
  1649.         )
  1650.       )
  1651.       ;; Do not set brk_e1 nil... it will be set later.
  1652.       ;; Now break the line or arc found at the end point
  1653.       ;; if there is one, and we are in a breaking mood.
  1654.       (if (and dl:brk brk_e2)
  1655.         (progn
  1656.           (if (eq brk_e1 brk_e2)
  1657.             (progn
  1658.               ;; Delete both arcs so we can find the arc or line that
  1659.               ;; we found previously.
  1660.               (entdel (nth 0 wnames))
  1661.               (entdel (nth 1 wnames))
  1662.               (dl_ved "brk_e2" nextpt)
  1663.               ;; Restore first line
  1664.               (entdel (nth 0 wnames))
  1665.               (entdel (nth 1 wnames))
  1666.             )
  1667.           )
  1668.           (if (null brk_e1)
  1669.             (progn
  1670.               (dl_mae T T)
  1671.               (dl_mae T nil)
  1672.             )
  1673.           )
  1674.           (command "_.BREAK" brk_e2 savpt3 savpt4)
  1675.         )
  1676.       )
  1677.       ;; Do not set brk_e2 nil... it will be set later.
  1678.     )
  1679.     ((= (rem uctr 2.0) 0)
  1680.       (setq fang nil)
  1681.       (dl_da2)                        ; Draw arc part 2
  1682.       (if fang
  1683.         (setq ftmp fang
  1684.               fang nil
  1685.         )
  1686.       )
  1687.       (setq save_1 ent)
  1688.       (setq sent1 (cdr(assoc -1 ent)))
  1689.       (setq pt2 (dl_a01 brk_e2 "3" nextpt T)) ; DLine_draw_Arc_0_and_1
  1690.       (if ftmp
  1691.         (setq fang ftmp
  1692.               ftmp nil
  1693.         )
  1694.       )
  1695.     )
  1696.     (T
  1697.       (dl_da2)                        ; Draw arc part 2
  1698.       (if fang
  1699.         (setq ftmp fang
  1700.               fang nil
  1701.         )
  1702.       )
  1703.       (setq save_2 ent)
  1704.       (setq sent1 (cdr(assoc -1 ent)))
  1705.       (setq pt2 (dl_a01 brk_e2 "4" nextpt T)) ; DLine_draw_Arc_0_and_1
  1706.       (if ftmp
  1707.         (setq fang fang
  1708.               ftmp nil
  1709.         )
  1710.       )
  1711.  
  1712.       ;; Now break the line or arc found at the end point
  1713.       ;; if there is one, and we are in a breaking mood.
  1714.       (if (and dl:brk brk_e2)
  1715.         (progn
  1716.           (dl_mae T T)
  1717.           (dl_mae T nil)
  1718.           (command "_.BREAK" brk_e2 savpt3 savpt4)
  1719.         )
  1720.       )
  1721.       ;; Do not set brk_e2 nil... it will be set later.
  1722.     )
  1723.   )
  1724.   (setq uctr   (1+ uctr))
  1725. )
  1726. ;;;
  1727. ;;; Set pt1 or pt2 based on whether there is an arc or line to be broken.
  1728. ;;;
  1729. ;;; dl_a01 == DLine_draw_Arcs_0_and_1
  1730. ;;;
  1731. (defun dl_a01 (bent1 n pt flg / pt1 pt2 ang1 ang2 anga angb)
  1732.   ;; "n" is the point to save for end capping
  1733.   (setq n (strcat "savpt" n))
  1734.   ;; "tmp" is the arc just created.
  1735.   ;; "bent1" is the line or arc to be broken, if there is one...
  1736.   (if bent1
  1737.     (if (= (dl_val 0 bent1) "LINE")
  1738.       (progn
  1739.         (set (read n) (dl_ial tmp (trans (dl_val 10 bent1) 0 1)
  1740.                                   (trans (dl_val 11 bent1) 0 1) pt))
  1741.       )
  1742.       (progn
  1743.         (setq curcpt (trans (dl_val 10 sent1) (dl_val -1 sent1) 1)
  1744.               prvcpt (trans (dl_val 10 bent1) (dl_val -1 bent1) 1)
  1745.               pt1    (polar prvcpt (dl_val 50 bent1) (dl_val 40 bent1))
  1746.               pt2    (polar curcpt (dl_val nn sent1) (dl_val 40 sent1))
  1747.               ang1   (angle prvcpt pt1)
  1748.         )
  1749.         (if (not (equal ang1 (angle prvcpt strtpt) 0.01))
  1750.           (setq pt1  (polar prvcpt (dl_val 51 bent1) (dl_val 40 bent1))
  1751.                 ang1 (angle prvcpt pt1)
  1752.                 ang2 (angle curcpt pt2)
  1753.                 anga (- ang1 ang2)
  1754.                 angb (- ang2 ang1)
  1755.           )
  1756.         )
  1757.         (if (or (and (< anga 0.0872665)
  1758.                      (> anga -0.0872665))
  1759.                 (and (< angb 0.0872665)
  1760.                      (> angb -0.0872665))
  1761.             )
  1762.           (progn
  1763.             (set (read n) pt)
  1764.             (if (= bent1 brk_e1)
  1765.               (setq brk_e1 nil)
  1766.               (setq brk_e2 nil)
  1767.             )
  1768.           )
  1769.           (set (read n) (dl_iaa sent1 bent1 pt flg))
  1770.         )
  1771.       )
  1772.     )
  1773.     (progn
  1774.       (setq cpt (trans (dl_val 10 tmp) (dl_val -1 tmp) 1))
  1775.       (set (read n) (polar cpt (angle cpt pt) orad))
  1776.     )
  1777.   )
  1778.   (eval (read n))
  1779. )
  1780. ;;;
  1781. ;;; Do more of the arc drawing stuff.  This is where we call the modify
  1782. ;;; functions for the previous arc or line segment.  The line end being
  1783. ;;; modified is always the group 11 end, but we have to test the start
  1784. ;;; and end angle of an arc to tell which end to modify.
  1785. ;;;
  1786. ;;; dl_da2 == DLine_Draw_Arc_segment_part_2
  1787. ;;;
  1788. (defun dl_da2 (/ pt)
  1789.   ;; get the corresponding previous entity
  1790.   (setq tmp1 (nth (- uctr 2) wnames)
  1791.         ent1 (entget tmp1))
  1792.   (if (= (dl_val 0 tmp1) "LINE")
  1793.     ;; if it's a line
  1794.     (setq pt (dl_mls T 11))
  1795.     ;; if it's an arc
  1796.     (setq pt (dl_mas nil T nil nil strtpt))
  1797.   )
  1798.   ;; pt is a point in the current UCS, not ECS
  1799.   (if pt
  1800.     (progn
  1801.       (setq ang (- (angle cpt pt) ange))
  1802.       (entmod (setq ent (subst (cons nn ang)
  1803.                        (assoc nn ent)
  1804.                        ent)))         ; modify arc endpt
  1805.     )
  1806.   )
  1807.   (if flgn                            ; if closing
  1808.     (progn
  1809.       (setq tmp1 (nth flgn wnames)
  1810.             ent1  (entget tmp1))  ; get the flagged entity
  1811.       (if (= (dl_val 0 tmp1) "LINE")
  1812.         ;; if it's a line
  1813.         (setq pt (dl_mls T 10))
  1814.         ;; if it's an arc
  1815.         (setq pt (dl_mas T T nil nil nextpt))
  1816.       )
  1817.       (if pt
  1818.         (progn
  1819.           (setq ang (- (angle cpt pt) ange))
  1820.           (setq nn (if (= nn 50) 51 50))
  1821.           (entmod (setq ent (subst (cons nn ang)
  1822.                          (assoc nn ent)
  1823.                          ent)))       ; modify arc endpt
  1824.         )
  1825.       )
  1826.     )
  1827.   )
  1828. )
  1829. ;;;
  1830. ;;; Modify the endpoints of an arc by changing the start and end angles.
  1831. ;;;
  1832. ;;; dl_mae == DLine_Modify_Arc_Endpoints
  1833. ;;;
  1834. (defun dl_mae (eflg sflg / nn1 nn2)
  1835.   (if (= nn 50)
  1836.     (setq nn1 50 nn2 51)
  1837.     (setq nn1 51 nn2 50)
  1838.   )
  1839.   (if sflg
  1840.     (if eflg
  1841.       (setq save_1 (subst (cons nn2
  1842.                                 (angle
  1843.                                   (trans cpt    1 (cdr(assoc -1 save_1)))
  1844.                                   (trans savpt3 1 (cdr(assoc -1 save_1)))
  1845.                                 )
  1846.                           )
  1847.                           (assoc nn2 save_1) save_1)
  1848.       )
  1849.       (setq save_1 (subst (cons nn1
  1850.                                 (angle
  1851.                                   (trans cpt    1 (cdr(assoc -1 save_1)))
  1852.                                   (trans savpt1 1 (cdr(assoc -1 save_1)))
  1853.                                 )
  1854.                           )
  1855.                           (assoc nn1 save_1) save_1)
  1856.       )
  1857.     )
  1858.     (if eflg
  1859.       (setq save_2 (subst (cons nn2
  1860.                                 (angle
  1861.                                   (trans cpt    1 (cdr(assoc -1 save_1)))
  1862.                                   (trans savpt4 1 (cdr(assoc -1 save_2)))
  1863.                                 )
  1864.                           )
  1865.                           (assoc nn2 save_2) save_2)
  1866.       )
  1867.       (setq save_2 (subst (cons nn1
  1868.                                 (angle
  1869.                                   (trans cpt    1 (cdr(assoc -1 save_1)))
  1870.                                   (trans savpt2 1 (cdr(assoc -1 save_2)))
  1871.                                 )
  1872.                           )
  1873.                           (assoc nn1 save_2) save_2)
  1874.       )
  1875.     )
  1876.   )
  1877.   (if sflg
  1878.     (entmod save_1)
  1879.     (entmod save_2)
  1880.   )
  1881. )
  1882. ;;;
  1883. ;;; Modify arc                        ; flg2 = nil if arc to line
  1884. ;;;                                   ;      = T   if arc to arc
  1885. ;;;
  1886. ;;; dl_mas == DLine_Modify_Arc_Segment
  1887. ;;;
  1888. (defun dl_mas (flg3 flg2 spt ept pt / nnn pt1 pt2 rad1 ange)
  1889.   ;; get some stuff
  1890.   (setq cpt1   (trans (dl_val 10 tmp1) (dl_val -1 tmp1) 1)
  1891.         rad1   (dl_val 40 tmp1)
  1892.         ang1   (dl_val 50 tmp1)
  1893.   )
  1894.   (if (null pt)                       ; if a point is not passed in:
  1895.     (setq pt (nth 0 spts))            ; set to initial saved start point.
  1896.   )
  1897.   (setq ange (trans '(1 0 0) (dl_val -1 tmp1) 1)
  1898.         ange (angle '(0 0 0) ange)
  1899.         ang1 (+ ang1 ange)
  1900.   )
  1901.   (if (> ang1 (* 2 pi))
  1902.     (setq ang1 (- ang1 (* 2 pi)))
  1903.   )
  1904.   (if (equal (angle cpt1 pt) ang1 0.01) ; figure out if we're looking
  1905.     (setq nnn 50)                     ; for the start or end point of
  1906.     (setq nnn 51)                     ; the beginning arc, then
  1907.   )                                   ; get the intersection point
  1908.   ;; if arc to arc
  1909.   (if flg2
  1910.     ;; then
  1911.     (progn
  1912.       ;; find intersection with arc
  1913.       (setq pt1 (dl_iaa tmp tmp1 (if flg3 nextpt strtpt) flg2))
  1914.       (if pt1
  1915.         (progn
  1916.           (setq ang1 (- (angle cpt1 pt1) ange))
  1917.           (setq ent1 (subst (cons nnn ang1)
  1918.                             (assoc nnn ent1)
  1919.                             ent1))
  1920.           (entmod ent1)               ; modify arc endpt
  1921.         )
  1922.       )
  1923.     )
  1924.     ;; else
  1925.     (progn
  1926.       ;; find arc intersection with line from spt to ept
  1927.       (setq pt1 (dl_ial tmp1 spt ept pt))
  1928.       (setq ang1 (- (angle cpt1 pt1) ange))
  1929.       (setq ent1 (subst (cons nnn ang1)
  1930.                         (assoc nnn ent1)
  1931.                         ent1))
  1932.       (entmod ent1)                   ; modify arc endpt
  1933.     )
  1934.   )
  1935.   pt1
  1936. )
  1937. ;;; ---------------- Begin Arc to Arc Functions ---------------------
  1938. ;;;
  1939. ;;; This routine does a variety of tasks: it calculate up to two
  1940. ;;; intersection points of two arcs,
  1941. ;;; then it attempts to determine which of the points serves as a
  1942. ;;; best-fit to the following criteria:
  1943. ;;;
  1944. ;;;   1) One end of the arc must lie "on" the arc.
  1945. ;;;   2) Given that the point given in 1 above is pt1,
  1946. ;;;      and that the other point is pt2, then if the arc crosses over
  1947. ;;;      the other arc then use pt2, otherwise the arc does not cross over
  1948. ;;;      the other arc so use pt1.
  1949. ;;;
  1950. ;;; If the two arcs do not intersect, then a line will be drawn
  1951. ;;; from the point of intersection of the arc and the perpendicular from
  1952. ;;; the line of the two arc centerpoints;  The arcs will be
  1953. ;;; trimmed or extended as needed to meet these points.
  1954. ;;;
  1955. ;;; If the two arcs are tangent, then they are
  1956. ;;; trimmed/extended to this point.
  1957. ;;;
  1958. ;;; Intersection point of two arcs or circles
  1959. ;;; a    = radius of ename 1
  1960. ;;; b    = distance from curcpt to prvcpt
  1961. ;;; c    = radius of ename 2
  1962. ;;; curcpt = center point of first circle or arc  -- bent1, bent2, tmp
  1963. ;;; prvcpt = center point of second circle or arc -- sent1, sent2, tmp1
  1964. ;;; npt  = near point for nearest test
  1965. ;;;
  1966. ;;; dl_iaa == DLine_Intersect_Arc_and_Arc
  1967. ;;;
  1968. (defun dl_iaa  (en1 en2 npt flga / a b c s ang alpha alph ipt
  1969.                                    curcpt prvcpt temp temp1 temp2)
  1970.   (setq curcpt  (trans (dl_val 10 en1) (dl_val -1 en1) 1) ; the "last" entity
  1971.         prvcpt  (trans (dl_val 10 en2) (dl_val -1 en2) 1) ; the previous entity
  1972.         a       (dl_val 40 en2)
  1973.         b       (distance curcpt prvcpt)
  1974.         c       (dl_val 40 en1)
  1975.         s       (/ (+ a b c) 2.0)
  1976.         ang     (angle curcpt prvcpt)
  1977.   )
  1978.   (cond
  1979.     ;; circles are tangent
  1980.     ;; If (- s a) == 0, this would cause a divide by zero below...
  1981.     ((or (= (- s a) 0) (equal b (+ a c) 0.001) (equal b (abs (- a c)) 0.001))
  1982.       ;; Circles are tangent.
  1983.       (setq ipt nil)
  1984.     )
  1985.     ;; circles do not intersect
  1986.     ((and (or (> b (+ a c)) (if (> c a) (< (+ a b) c) (< (+ c b) a)))
  1987.           (not (equal (+ a b ) c (/ (+ a b c) 1000000))))
  1988.       ;; No intersection.
  1989.       (if (= flg 4)
  1990.         (progn
  1991.           (setq ipt (polar curcpt (angle curcpt prvcpt) c))
  1992.           (command "_.LINE" (polar prvcpt (angle prvcpt ipt) a) ipt "")
  1993.         )
  1994.         (progn
  1995.           (setq ipt (polar curcpt (angle curcpt prvcpt) c))
  1996.           (command "_.LINE" (polar prvcpt (angle prvcpt ipt) a) ipt "")
  1997.         )
  1998.       )
  1999.     )
  2000.     (T
  2001.       ;; general law of cosines formula -- (- s a) != 0
  2002.       (setq alpha (* 2.0 (atan (sqrt (abs (/ (* (- s b) (- s c))
  2003.                                              (* s (- s a)))))))
  2004.       )
  2005.  
  2006.       (setq tpt1 (polar curcpt (+ ang alpha) c)
  2007.             tpt2 (polar curcpt (- ang alpha) c)
  2008.             anga  (angle curcpt npt)
  2009.             angb  (angle prvcpt npt)
  2010.       )
  2011.       ;; Two intersections. Now...
  2012.       ;; If drawing arcs, fang is set, we're past the first segment...
  2013.       ;; Reset the `near' point based on the previous ipt.  This can be
  2014.       ;; quite different and necessary from the `npt' passed in.
  2015.       (if (and dl_arc fang (> uctr 1))
  2016.         (setq npt (polar prvcpt fang c))
  2017.       )
  2018.       (if (< (distance tpt1 npt) (distance tpt2 npt))
  2019.         (setq temp tpt1
  2020.               tpt1 tpt2
  2021.               tpt2 temp
  2022.         )
  2023.       )
  2024.       (setq temp (angle prvcpt curcpt)) ; angle from prev ent to this ent
  2025.       (setq ipt (dl_bap en1 en2 tpt2 tpt1 nil))
  2026.       (if fang
  2027.         (setq fang nil)
  2028.         (if dl_arc (setq fang (angle cpt ipt)))
  2029.       )
  2030.     )
  2031.   )
  2032.   (setq cpt curcpt)
  2033.   (setq cpt1 prvcpt)
  2034.   ipt                                 ; return point
  2035. )
  2036. ;;;
  2037. ;;; Get the best point for the arc/arc intersection.
  2038. ;;;
  2039. ;;; dl_bap == DLine_Best_Point_to_Arc
  2040. ;;;
  2041. (defun dl_bap (en1 en2 pp1 pp2 flg / temp1 temp2)
  2042.   (setq temp1 (dl_ona en1 pp2)
  2043.         temp2 (dl_ona en2 pp2)
  2044.   )
  2045.   (if temp2
  2046.     (if (and (< uctr 2)
  2047.              (and brk_e1 brk_e2))
  2048.       pp1
  2049.       (if temp1
  2050.         (if (< uctr 2)
  2051.           pp2
  2052.           (if (not fang) pp2 pp1)
  2053.         )
  2054.         pp1
  2055.       )
  2056.     )
  2057.     pp1
  2058.   )
  2059. )
  2060. ;;; ----------------- End Arc  Drawing Functions --------------------
  2061. ;;; -------------------- Begin Misc Functions -----------------------
  2062. ;;;
  2063. ;;; Add the entity name to the list in wnames.
  2064. ;;;
  2065. ;;; dl_atl == DLine_Add_To_List
  2066. ;;;
  2067. (defun dl_atl ()
  2068.   (setq wnames (if (null wnames)
  2069.                  (list (entlast))
  2070.                  (append wnames (list tmp)))
  2071.   )
  2072.   wnames
  2073. )
  2074. ;;;
  2075. ;;; The value of the assoc number of <ename>
  2076. ;;;
  2077. (defun dl_val (v temp)
  2078.   (cdr(assoc v (entget temp)))
  2079. )
  2080. ;;;
  2081. ;;; List stripper : strips the last "v" members from the list
  2082. ;;;
  2083. (defun dl_lsu (lst v / m)
  2084.   (setq m 0 temp '())
  2085.   (repeat (- (length lst) v)
  2086.     (progn
  2087.       (setq temp (append temp (list (nth m lst))))
  2088.       (setq m (1+ m))
  2089.   ) )
  2090.   temp
  2091. )
  2092. ;;;
  2093. ;;; Bitwise DLINE endcap setting function.
  2094. ;;;
  2095. (defun endcap ()
  2096.   (initget "Auto Both End None Start")
  2097.   (setq dl:ecp (getkword
  2098.     "\níu½╩║▌ív│B▓zñΦªí?  B¿Γ║▌/E▓╫ñε║▌/Nñú½╩║▌/S░_⌐l║▌/<Aª█░╩>: "))
  2099.   (cond
  2100.     ((= dl:ecp "None")
  2101.       (setq dl:ecp 0)
  2102.     )
  2103.     ((= dl:ecp "Start")
  2104.       (setq dl:ecp 1)
  2105.     )
  2106.     ((= dl:ecp "End")
  2107.       (setq dl:ecp 2)
  2108.     )
  2109.     ((= dl:ecp "Both")
  2110.       (setq dl:ecp 3)
  2111.     )
  2112.     (T  ; Auto
  2113.       (setq dl:ecp 4)
  2114.     )
  2115.   )
  2116. )
  2117. ;;;
  2118. ;;; Set these defaults when loading the routine.
  2119. ;;;
  2120. (if (null dl:ecp) (setq dl:ecp 4))    ; default to auto endcaps
  2121. (if (null dl:snp) (setq dl:snp T))    ; default to snapping ON
  2122. (if (null dl:brk) (setq dl:brk T))    ; default to breaking ON
  2123. (if (null dl:osd) (setq dl:osd 0))    ; default to center alignment
  2124. ;;;
  2125. ;;; These are the c: functions.
  2126. ;;;
  2127. (defun c:dl () (dline))
  2128. (defun c:dline () (dline))
  2129.  
  2130. (princ "  íuDLINEívñw╕ⁿñJíC")
  2131. (princ)
  2132.